質問: 今、2つのExcelのブックがあります。 ブックBのK列には、空白セルとデータが混じってます。 ※(行目)|文字列 1|あいうえお 2|(空白セル) 3|(空白セル) 4|(空白セル) 5|かきくけこ 6|(空白セル) 7|(空白セル) 8|さしすせそ ・ ・ ブックAのZ列には、 1|あいうえおのこと 2|あいうえおについて 3|あいうえおです 4|かきくけこの発声練習 5|かきくけこについて 6|さしすせそです 7|さしすせその勉強 8|さしすせそのアクセント 9|さしすせそについて ・ ・ のようなデータが入ってます。 この状況にて。 ブックBのK列の空白セルは無視し、データのあるセルの文字列(1とします)を1つずつ、ブックAのZ列にあるかどうか探します。(ブックAのZ列のセルとは完全一致しなくてもよいです) そして、一致した場合は。 一致した“最初の該当データ”から右に13(AM列)、下に1セル移動した箇所のセルに、1の文字列を貼り付けたいのです。そのような処理が出来るマクロ等お教えいただけないでしょうか。 ※”最初の該当データ”とは、今回の例でいいますと、 1|あいうえおのこと 4|かきくけこの発声練習 6|さしすせそです になります。
回答: 以下のコードをブックA の標準モジュールに貼り付けて、サブルーチンの先頭の変数 ref_book_filename にブックB のファイル名をフルパスで設定してください。 そして、set_data サブルーチンを実行してください。 ``` Sub set_data() ref_book_filename = "d:\foo\bar.xlsx" ' 参照先の Book (フルパス) ref_column = 11 ' K列 search_column = 26 ' Z列 write_column = search_column + 13 ' AM列 Set this_book = ActiveWorkbook Set ref_book = Workbooks.Open(ref_book_filename) this_book.Activate ' 別シートの値を読み込む Set ref_sheet = ref_book.Sheets(1) ' ひとつめのシート last_row = ref_sheet.Cells(Rows.Count, ref_column).End(xlUp).Row Set Map = CreateObject("Scripting.Dictionary") For r = 1 To last_row Set cell = ref_sheet.Cells(r, ref_column) If Not IsEmpty(cell) And Not cell.Value = "" Then Map.Add cell.Value, cell.Value End If DoEvents Next ref_book.Close Set ref_book = Nothing ' 対象シートから探して、値を書き込む last_row = Cells(Rows.Count, search_column).End(xlUp).Row For Each Key In Map.keys Debug.Print Key For r = 1 To last_row If InStr(Cells(r, search_column).Value, Key) > 0 Then Cells(r + 1, write_column).Value = Key Exit For End If DoEvents Next Next Set Map = Nothing End Sub ``` ブックB のどのシートにデータが入っているかが書いてなかったので、最初のシートから K列の値を読み込むようにしています。 以下のことを前提としています。 * ブックB の K列に入ってる値は重複していない。 * ブックA の Z列に入っているブックB の K列の値は近くにかたまっていて、離れたところには存在しない。 * ブックA の Z列は、部分一致で探します。 「あいうえお」は、「ここにもあいうえお」にもマッチします。 二番目の前提は、こういうことです。 ``` 1|あいうえおのこと 2|あいうえおについて あいうえお 3|あいうえおです 4|かきくけこの発声練習 5|かきくけこについて かきくけこ 6|さしすせそです 7|さしすせその勉強 さしすせそ 8|さしすせそのアクセント 9|さしすせそについて ... 100|また、あいうえお ※ここには、「あいうえお」は書かれない ```