質問です

Question

inosisi

146

144もっと見る

100pt

コンピュータインターネット

質問です

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

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

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

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回まで

登録：2011/07/23 11:03:31
終了：2011/07/25 11:43:29

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

No.2

km1981429492011/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

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

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

僕はいりません

ありがとうございます

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

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

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

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

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

2011/07/25 11:00:36

きゃづみぃ 2011/07/23 19:16:13

CSVの場合、Sheet1しか存在しません。

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

ちなみにエクセルCSVというのもないです。
きゃづみぃ 2011/07/25 11:21:05

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

原因は
＞データ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列の件数)が多い場合は遅くなっちゃいます。
ここらへんは少し修正しないとダメですが・・・。
変更すれば若干速くなるかと。
きゃづみぃ 2011/07/25 11:21:43

ま、ドメイン数はそんなに多くないだろうってことで修正版は作ってないです。
inosisi 2011/07/25 11:42:58

takntさん
ありがとうございます
Dim i1, i2, i3, n1, n2 As Integer
↓
＞Dim i1, i2, i3, n1, n2 As Long

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

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

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

リクエスト送信済

回答リクエストを送信したユーザーはいません

きゃづみぃ · Accepted Answer · 2011-07-23T19:24:35+09:00

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

きゃづみぃ · Accepted Answer · 2011-07-23T19:24:35+09:00

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

質問です

ベストアンサー

きゃづみぃ1353911982011/07/23 19:24:35

その他の回答（1件）

きゃづみぃ1353911982011/07/23 19:24:35ここでベストアンサー

km1981429492011/07/23 23:27:18

コメント（4件)

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