人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

2つのブック間のデータを比較して、一致したら片方のデータの右に4セル隣のデータを貼り付けたいです。

Excelの質問です。
今、ブックAのAM列には、

※(行目)|文字列

1|あいうえお
2|かきくけこ
3|(空白セル)
4|さしすせそ
5|たちつてと
6|(空白セル)
7|なにぬねの




と、空白セルと文字列が入ったデータが混じって入ってます。(重複データはおそらくありません)

そしてブックBのK列には、

1|さしすせそ
2|あいうえお
3|(空白セル)
4|かきくけこ
5|なにぬねの
6|(空白セル)
7|たちつてと




と、同じく文字列セルと空白セルが入ってます。(重複データはおそらくありません)

この状況におきまして。
ブックA・AM列とブックB・K列の文字列をそれぞれ比較(空白セルは無視)し、完全一致した場合、ブックB・K列の該当セルから右に4つ移動したセル(O列)をコピーして。
ブックA・AM列の該当セルから右に5つ移動したセル(AR列)に貼り付けたいのです。
そのような処理がマクロ等で可能でしたらお教えいただけますでしょうか。
よろしくお願い致します。

●質問者: moon-fondu
●カテゴリ:コンピュータ 学習・教育
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● a-kuma3
●1800ポイント ベストアンサー

以下のコードをブックA の標準モジュールに貼り付けて、サブルーチンの先頭の変数 ref_book_filename にブックB のファイル名をフルパスで設定してください。
そして、set_data3 サブルーチンを実行してください。

Sub set_data3()
 ref_book_filename = "d:\foo\bar.xlsx"  ' 参照先の Book (フルパス)
 ref_key_column = 11  ' K列
 ref_value_column = ref_key_column + 4  ' O列
 search_column = 39  ' AM列
 write_column = search_column + 5  ' AR列

 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_key_column).End(xlUp).Row

 Set Map = CreateObject("Scripting.Dictionary")
 For r = 1 To last_row
 Set cell = ref_sheet.Cells(r, ref_key_column)
 If Not IsEmpty(cell) And Not cell.Value = "" Then
 If Not Map.Exists(cell.Value) Then
 Map.Add cell.Value, ref_sheet.Cells(r, ref_value_column).Value
 End If
 End If
 DoEvents
 Next

 ref_book.Close
 Set ref_book = Nothing

  ' 対象シートから探して、値を書き込む
 last_row = Cells(Rows.Count, search_column).End(xlUp).Row
 For r = 1 To last_row
 Set cell = Cells(r, search_column)
 If Not IsEmpty(cell) And Not cell.Value = "" Then
 Cells(r, write_column).Value = Map.Item(cell.Value)
 End If
 DoEvents
 Next

 Set Map = Nothing

End Sub

質問に書かれていない範囲で、以下のような動作をするように書いてます。


moon-fonduさんのコメント
ありがとうございます、うまく処理が出来ました!助かりました(^^;)
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ