Excelで2つのシートの2つの列の文字列を5万行ぐらい比較して、部分一致したら、一致したSheet2のセルの8列隣りの文字列をコピーしてSheet1の指定のセルに貼りたい。


2つのシートがあります。名前は「Sheet1」「Sheet2」。
Sheet1のG21行目に「りんご」。
Sheet2のA67行目に「ああありんごabc」と入っております。
Sheet2のI67行目には「りんごは赤い」。
また、Sheet1のG34行目に「ごりら」。
Sheet2のA325行目に「あああごりらabc」と入っております。
Sheet2のI325行目には「ごりらは大きい」。
このようなデータが、各シート5万行ぐらい続いております。
Sheet1・G列と、Sheet2・A列を比較し。
Sheet1のG列のセルの文字列が、Sheet2のA列のとあるセルと部分一致した場合。
Sheet2の一致したセルから8列横のI列のセルの文字列を。
コピーか切り取りし、それをSheet1のG列から2列横のE列に貼付けたいのです。

上記の例ですとSheet1のE21に「りんごは赤い」、E34に「ごりらは大きい」となるようにしたいです。
そのような関数やマクロをお教えいただけないでしょうか。
サンプルファイルも置きました。http://xfs.jp/K4AiNT
よろしくお願いします。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2014/11/15 12:30:52
  • 終了:2014/11/18 03:21:41

ベストアンサー

id:a-kuma3 No.1

a-kuma3回答回数4583ベストアンサー獲得回数19232014/11/15 13:26:03

ポイント150pt

こんな感じに作ってみました。
サブルーチン find_and_copy を実行してください。

Const MAX_ROW = 50      ' Sheet1 を探す行数

Sub find_and_copy()
    ' Sheet1 の 1行目から MAX_ROW 行目まで、繰り返し
    For r = 1 To MAX_ROW
        ' Sheet1 の G列のセル
        Set cell = Sheets("Sheet1").Cells(r, 7)

        ' G列のセルに、何かデータがあれば
        If Not IsEmpty(cell) Then
            ' Sheet2 の A列から、部分一致で探す
            Set result = Sheets("Sheet2").Range("A:A").Find(What:=cell.Value, LookAt:=xlPart)

            ' もし、見つかったら
            If Not result Is Nothing Then
                ' 見つかった行の I列の値を、Sheet1 の E列の値にコピー
                Sheets("Sheet1").Cells(r, 5).Value = result.EntireRow.Cells(1, 9)
            End If
        End If
    Next
End Sub

Sheet1 で探す行数を定数で決めてます。
少なめの値で確かめてみてから、様子を見て大きくしてみてください。
さすがに五万行あると、どれくらい時間がかかるか、ちょっと分からないので。

id:moon-fondu

ありがとうございます、5000行だとうまくいきました!
5万行ですと・・・フリーズしてExcelが動かなくなってしまいましたね(苦笑)

2014/11/18 03:19:03

その他の回答(1件)

id:a-kuma3 No.1

a-kuma3回答回数4583ベストアンサー獲得回数19232014/11/15 13:26:03ここでベストアンサー

ポイント150pt

こんな感じに作ってみました。
サブルーチン find_and_copy を実行してください。

Const MAX_ROW = 50      ' Sheet1 を探す行数

Sub find_and_copy()
    ' Sheet1 の 1行目から MAX_ROW 行目まで、繰り返し
    For r = 1 To MAX_ROW
        ' Sheet1 の G列のセル
        Set cell = Sheets("Sheet1").Cells(r, 7)

        ' G列のセルに、何かデータがあれば
        If Not IsEmpty(cell) Then
            ' Sheet2 の A列から、部分一致で探す
            Set result = Sheets("Sheet2").Range("A:A").Find(What:=cell.Value, LookAt:=xlPart)

            ' もし、見つかったら
            If Not result Is Nothing Then
                ' 見つかった行の I列の値を、Sheet1 の E列の値にコピー
                Sheets("Sheet1").Cells(r, 5).Value = result.EntireRow.Cells(1, 9)
            End If
        End If
    Next
End Sub

Sheet1 で探す行数を定数で決めてます。
少なめの値で確かめてみてから、様子を見て大きくしてみてください。
さすがに五万行あると、どれくらい時間がかかるか、ちょっと分からないので。

id:moon-fondu

ありがとうございます、5000行だとうまくいきました!
5万行ですと・・・フリーズしてExcelが動かなくなってしまいましたね(苦笑)

2014/11/18 03:19:03
id:Lhankor_Mhy No.2

Lhankor_Mhy回答回数779ベストアンサー獲得回数2312014/11/15 13:40:43

ポイント150pt

セルE21に以下の数式を

=VLOOKUP("*"&G21&"*",Sheet2!A:I,9,0)
id:a-kuma3

VLOOKUP は、迷った。
五万行というのが、どっちのシートか分からないけど、再計算で固まるんじゃないかと……

2014/11/15 16:44:43
id:moon-fondu

関数に関係ない項目を一旦削除して、お教えいただきましたVLOOKUPで少しずつ関数を反映させていくと、何とか全ての行にデータを反映できそうです。
ありがとうございました。

2014/11/18 03:20:52

コメントはまだありません

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

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

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

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