VBAで A と B のブックを比較して、Bのある列の値をAに転記したいです。

VBAについてです。

前提・実現したいこと

VBAで2つのブックを比較して、データの転記がしたいです。
Book1(sheet1) 転記するシート　
Book2(sheet1) 転記元のシート

このbook1とbook2のある列のデータを比較して、数値が同じならbook2のある列のデータをbook1の対応する列に転記するといった動作をやりたいです。

具体的には、
book1のD列の2行目のデータをbook2のD列から検索して、合致しているデータがあれば、
book2の合致した行にあるY列のデータをbook1の2行目のO列に転記する。
この動作をbook1のD列の3行目、4行目...最終行まで繰り返し処理をしたいです。

それぞれのbookのイメージとして、book1は売上伝票をまとめたようなもので、book2はユーザーのマスタのようなものです。

動きのイメージとしては関数のvlookupに近いと思います。

発生している問題・エラーメッセージ

book1のD2のデータをbook2のD列から検索して、検索が終わったら次のbook1のD3のデータを検索する、という動きがifやforなどを使えばできそうなのはなんとなくわかるのですが、具体的にどうすればいいのかわかりません。涙

該当のソースコード

VBA
1    Public Sub ブック間転送()
2'ループ用の変数
3    Dim m As Long
4    Dim n As Long
5    Dim row1 As Long        'Book1 O列へ書き込む行番号
6    Dim s1 As Worksheet
7    Dim s2 As Worksheet
8
9    Set s1 = Workbooks("book1.xlsx").Worksheets(1)
10    Set s2 = Workbooks("book2.xlsx").Worksheets(1)
11    row1 = 2
12    'それぞれのシートの比較行を最終行までループ
13    For m = 2 To s1.Cells(Rows.Count, 4).End(xlUp).Row
14        For n = 2 To s2.Cells(Rows.Count, 4).End(xlUp).Row
15
16            'book1とbook2のD列の比較　これだと列ごとに比較してしまうので
17            'book1の(m,4)をbook2のD列の全てのデータと比較して、転記が終わってから次の処理に移りたいです。
18            If s1.Cells(m, 4).Value = s2.Cells(n, 4).Value Then
19                s1.Cells(row1, "O").Value = s2.Cells(n, "Y").Value
20                row1 = row1 + 1
21            End If
22        Next
23    Next
24End Sub

試したこと

補足情報（FW/ツールのバージョンなど）

左がbook1で右がbook2です。
book1のD列のd2をbook2のD列から検索して、Y列の1001という値をbook1のO列に転記したいです。
d1なら対応するO列に1000が入ります。これを1行ずつ繰り返すような処理です。

どうぞよろしくお願いいたします。

meg_

2019/09/18 10:25

掲載のコードはエラーとなり実行できません。まずはエラーを修正してください。

yama0131

2019/09/18 10:47

ご指摘ありがとうございます！確認して修正します！

tatsu99

2019/09/18 12:49 編集

検索した結果、実際にO列に設定される値を記入していただけませんでしょうか。 Book2のD列は重複した値はないのでしょうか。 Book1はおよそ何行ありますか。 Book2はおよそ何行ありますか。

yama0131

2019/09/18 13:12

検索した結果は画像を差し替えたので確認お願いします！ book2のD列には重複するデータはありません。顧客の名前や番号をリスト化したものになっています。 book1は50行　book2は150行ほどになります。

行動規範の内容に同意します

回答4件

前回、回答者です。

ただ、book2のY列にデータがなかった場合にbook1のO列に0を入れようと思ったのですが、
その場合はIF文をデータがない場合といったように分岐させるのがいいでしょうか？

はい、そのようにします。以下サンプルです。

VBA
1Public Sub ブック間転送()
2'ループ用の変数
3    Dim m As Long
4    Dim n As Long
5    Dim row1 As Long        'Book1 O列へ書き込む行番号
6    Dim s1 As Worksheet
7    Dim s2 As Worksheet
8
9    Set s1 = Workbooks("book1.xlsx").Worksheets(1)
10    Set s2 = Workbooks("book2.xlsx").Worksheets(1)
11    'それぞれのシートの比較行を最終行までループ
12    For m = 2 To s1.Cells(Rows.Count, 4).End(xlUp).Row
13        s1.Cells(m, "O").Value = ""
14        For n = 2 To s2.Cells(Rows.Count, 4).End(xlUp).Row
15
16            'book1とbook2のD列の比較　これだと列ごとに比較してしまうので
17            'book1の(m,4)をbook2のD列の全てのデータと比較して、転記が終わってから次の処理に移りたいです。
18            If s1.Cells(m, 4).Value = s2.Cells(n, 4).Value Then
19                If s2.Cells(n, "Y").Value = "" Then
20                    s1.Cells(m, "O").Value = 0
21                Else
22                    s1.Cells(m, "O").Value = s2.Cells(n, "Y").Value
23                End If
24                Exit For
25            End If
26        Next
27    Next
28End Sub
29

投稿2019/09/18 14:33

tatsu99

総合スコア5438

yama0131

2019/09/19 00:11

IFを2つ使えばよかったんですね！いろいろとありがとうございました！もっと勉強します！

行動規範の内容に同意します

ベストアンサー

あなたの提示されたソースに追加及び修正を加えました。

vba
1Public Sub ブック間転送()
2'ループ用の変数
3    Dim m As Long
4    Dim n As Long
5    Dim row1 As Long        'Book1 O列へ書き込む行番号
6    Dim s1 As Worksheet
7    Dim s2 As Worksheet
8
9    Set s1 = Workbooks("book1.xlsx").Worksheets(1)
10    Set s2 = Workbooks("book2.xlsx").Worksheets(1)
11    row1 = 2
12    'それぞれのシートの比較行を最終行までループ
13    For m = 2 To s1.Cells(Rows.Count, 4).End(xlUp).Row
14        For n = 2 To s2.Cells(Rows.Count, 4).End(xlUp).Row
15
16            'book1とbook2のD列の比較　これだと列ごとに比較してしまうので
17            'book1の(m,4)をbook2のD列の全てのデータと比較して、転記が終わってから次の処理に移りたいです。
18            If s1.Cells(m, 4).Value = s2.Cells(n, 4).Value Then
19                s1.Cells(row1, "O").Value = s2.Cells(n, "Y").Value
20                row1 = row1 + 1
21            End If
22        Next
23    Next
24End Sub
25