質問です

エクセルCSVで
Sheet1のA列の1行目からメールアドレスのデータがあります

Sheet2のA列の1行目からドメインの参照データがあります

Sheet2のA列の参照ドメインと同じものが含まれるメールアドレスを
Sheet1のA列のメールアドレスから抽出してその結果をSheet3のA列の1行目からコピーできるマクロまたは関数をお願いします

Sheet1 A列のデータ
aaaa@docomo.ne.jp
bbbb@ezweb.ne.jp
cccc@jcom.ne.jp

Sheet2 A列の参照ドメイン
docomo.ne.jp
ezweb.ne.jp

Sheet3 A列の結果
aaaa@docomo.ne.jp
bbbb@ezweb.ne.jp

よろしくお願いします

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2011/07/23 11:03:31
  • 終了:2011/07/25 11:43:29

ベストアンサー

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982011/07/23 19:24:35

ポイント70pt
Sub main()
    If Worksheets("Sheet2").Range("A1") = "" Then Exit Sub
    If Worksheets("Sheet2").Range("A2") = "" Then
        e = 1
    Else
        e = Worksheets("Sheet2").Range("A1").End(xlDown).Row
    End If

    If Worksheets("Sheet1").Range("A1") = "" Then Exit Sub
    If Worksheets("Sheet1").Range("A2") <> "" Then
        kg = Worksheets("Sheet1").Range("A1").End(xlDown).Row
    End If
    
    If Worksheets("Sheet3").Range("A1") = "" Then
        kk = 1
    Else
        If Worksheets("Sheet3").Range("A2") <> "" Then
            kk = Worksheets("Sheet3").Range("A1").End(xlDown).Row
        End If
    End If
    
    For gg = 1 To e
       For b = kg To 1 Step -1
            chk = Worksheets("Sheet2").Cells(gg, "A").Value
            If Right(Worksheets("Sheet1").Cells(b, "A"), Len(chk)) = chk Then
                Worksheets("Sheet3").Cells(kk, "A") = Worksheets("Sheet1").Cells(b, "A")
                kk = kk + 1
            End If
       Next b
    Next gg

End Sub
id:inosisi4141

上手く行きました。ありがとうございます。

手順としましては

1.データCSVファイルをエクセルで開く

2.Sheet1にデータsheet2に参照sheet3に答えの準備

3.マクロ実行

4.sheet3の答えをCSVで保存

エクセルCSVはありませんのでCSVをエクセルで開くという意味です

すみません素人判断です

2011/07/25 10:54:22

その他の回答(1件)

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982011/07/23 19:24:35ここでベストアンサー

ポイント70pt
Sub main()
    If Worksheets("Sheet2").Range("A1") = "" Then Exit Sub
    If Worksheets("Sheet2").Range("A2") = "" Then
        e = 1
    Else
        e = Worksheets("Sheet2").Range("A1").End(xlDown).Row
    End If

    If Worksheets("Sheet1").Range("A1") = "" Then Exit Sub
    If Worksheets("Sheet1").Range("A2") <> "" Then
        kg = Worksheets("Sheet1").Range("A1").End(xlDown).Row
    End If
    
    If Worksheets("Sheet3").Range("A1") = "" Then
        kk = 1
    Else
        If Worksheets("Sheet3").Range("A2") <> "" Then
            kk = Worksheets("Sheet3").Range("A1").End(xlDown).Row
        End If
    End If
    
    For gg = 1 To e
       For b = kg To 1 Step -1
            chk = Worksheets("Sheet2").Cells(gg, "A").Value
            If Right(Worksheets("Sheet1").Cells(b, "A"), Len(chk)) = chk Then
                Worksheets("Sheet3").Cells(kk, "A") = Worksheets("Sheet1").Cells(b, "A")
                kk = kk + 1
            End If
       Next b
    Next gg

End Sub
id:inosisi4141

上手く行きました。ありがとうございます。

手順としましては

1.データCSVファイルをエクセルで開く

2.Sheet1にデータsheet2に参照sheet3に答えの準備

3.マクロ実行

4.sheet3の答えをCSVで保存

エクセルCSVはありませんのでCSVをエクセルで開くという意味です

すみません素人判断です

2011/07/25 10:54:22
id:km1981 No.2

km1981回答回数429ベストアンサー獲得回数492011/07/23 23:27:18

ポイント30pt

これでできると思います

Public Sub hatena()

Dim i1, i2, i3, n1, n2 As Integer

Dim adr As String

Dim ss As Variant

n1 = Worksheets("Sheet1").Range("A1").End(xlDown).Row

n2 = Worksheets("Sheet2").Range("A1").End(xlDown).Row

i3 = 1

For i1 = 1 To n1

adr = Worksheets("Sheet1").Cells(i1, 1).Value

If (adr <> "") Then

ss = Split(adr, "@")

flag = False

For i2 = 1 To n2

If (ss(1) = Worksheets("Sheet2").Cells(i2, 1).Value) Then

Worksheets("Sheet3").Cells(i3, 1).Value = adr

i3 = i3 + 1

i2 = n2 + 1

End If

Next i2

End If

Next i1

End Sub


でも1番の人がとても怖いので

1番の人にベストアンサーをあげてください

僕はいりません

id:inosisi4141

ありがとうございます

「インデックスが有効範囲でありません」のエラーメッセージがでます

結果データも全部抽出していないみたいです

使用しているエクセルはMicrosoft Office Excel 2007です

データ100万件でテストしました

なにか原因がわかりましたらよろしくお願いします。

2011/07/25 11:00:36
  • id:taknt
    CSVの場合、Sheet1しか 存在しません。

    Sheet2やSheet3となると エクセルブックです。

    ちなみに エクセルCSVというのもないです。
  • id:taknt
    >「インデックスが有効範囲でありません」のエラーメッセージがでます

    原因は
    >データ100万件でテストしました

    なので
    >Dim i1, i2, i3, n1, n2 As Integer

    のように Integerで宣言しちゃうと オーバーフローになっちゃうのです。

    この場合は Longで 宣言しないと ダメですね。


    Dim i1, i2, i3, n1, n2 As Integer

    >Dim i1, i2, i3, n1, n2 As Long


    100万件もあるならば 高速化に工夫しないと ダメですねぇ。

    私のも チェックするドメイン数(sheet2のA列の件数)が 多い場合は 遅くなっちゃいます。
    ここらへんは 少し 修正しないとダメですが・・・。
    変更すれば 若干 速くなるかと。
  • id:taknt
    ま、ドメイン数は そんなに 多くないだろうってことで 修正版は 作ってないです。
  • id:inosisi4141
    takntさん
    ありがとうございます
    Dim i1, i2, i3, n1, n2 As Integer

    >Dim i1, i2, i3, n1, n2 As Long

    の修正しましたら上手く行きました
    ありがとうございました
    早さはどちらも同じくらいでこれくらいで大丈夫です
    いろいろ皆さんにはこちらの質問内容が不十分でご迷惑おかけします
    今後ともよろしくお願いします。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません