VBA：ブック間で値が一致したときに転記

Question

VBAで値が一致したときに転記するマクロを組んでいるのですが、うまいこと転記できず困っております。

前提・実現したいこと

ざっくりとどういう動きをさせたいかですが、
商品コードのマスタと、棚卸した結果のブックがあり、両ブックの項番が一致したとき、
棚卸結果をマスタに転記させるというものです。

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

以下コードにて実行したのですが、そもそもVBAへの理解度が乏しく全量把握できておりません...；；
圧倒的な知識不足により質問の意図がうまく伝えられず申し訳ございませんが何卒、皆様のお力をお借りしたく...

以下、当サイトで質問されていたコードを基に作成いたしました。

  Public Sub ブック間転記()
'ループ用の変数
    Dim m As Long
    Dim n As Long
    Dim row1 As Long        'マスタ C,D列へ書き込む行番号
    Dim s1 As Worksheet
    Dim s2 As Worksheet

    Set s1 = Workbooks("マスタ.xlsx").Worksheets(1)
    Set s2 = Workbooks("棚卸結果.xlsx").Worksheets(1)
    row1 = 2
    'それぞれのシートの比較行を最終行までループ
    For m = 2 To s1.Cells(Rows.Count, 1).End(xlUp).Row
        For n = 2 To s2.Cells(Rows.Count, 4).End(xlUp).Row

            'マスタと棚卸結果列の比較　これだと列ごとに比較してしまうので
            'マスタの(m,1)を棚卸結果のD列の全てのデータと比較して、転記が終わってから次の処理に移りたい。
            If s1.Cells(m, 1).Value = s2.Cells(n, 4).Value Then
                s1.Cells(row1, "C").Value = s2.Cells(n, "A").Value
                row1 = row1 + 1
            End If
        Next
    Next
End Sub

試したこと

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

・マスタは連番で採番されている
・棚卸結果は項番がバラバラ
・マスタ、棚卸結果、どちらも40万行ほど

マスタ例↓
　

棚卸結果例↓

マスタA列と、棚卸結果D列が一致したとき、マスタC,D列に棚卸結果A,B列を転記したいです。
また、要件が40万行と多いこともあり処理速度の向上についても助言いただきたく...

当方、業務でVBAを使用したことがないのですが必要だとのことで依頼されまして、
周りはVBAを使ったことがない方で解決にも至らず大変困っております...；；；

何卒よろしくお願い致します。

Comments

[meg_]

VBAではなくエクセルの関数ではダメなのでしょうか？

[andrehisamoto]

コメントありがとうございます！

要件が40万行ほどある事もあり、今後も使いたいのでVBAで、とのご依頼でして…;;

[okakemetal]

商品コードマスタのデータは固定で、棚卸のデータが可変として理解したので
その内容で話を進めます（そもそもの理解がずれていたらすいません）
商品コードのマスタを配列に入れます。（データ数固定の配列）
棚卸のデータも配列に入れいます（データ数変動の配列）

棚卸のデータをループを読み込んで、商品コードマスタとマッチングさせる
結果を配列に格納

全チェックが終わった時点で棚卸データの配列をセルに貼り付け

というような流れでコーディングを検討ください

[pig_vba]

一つ気になったのですが、一致したときに転記するマスタ側の行はm行目ではなくrow1行目なのですか?これだと仮に2行目該当なし→3行目該当番ありだった時に2行目に転記されると思うのですが仕様通りですか?

もう一点、棚卸結果の項番は被り無しですか?それとも、「同じ項番が複数あって最新のものを採用したい」ですか？どちらかで実装仕様が変わってきますね

[tatsu99]

マスタの項番は、間違いなく1からの連番で作成されていますか。（歯抜けなし）
もし、それが保証されているなら、検索処理を行う必要はありません。
棚卸データの項番の値＋１が、マスタデータの対象行になります。
例
棚卸データの項番＝１０　→マスタの１１行がマスタの項番＝１０
棚卸データの項番＝１５　→マスタの１６行がマスタの項番＝１５
この方法が処理速度では圧倒的に速くなります。
1からの連番であることが、保証されないなら、使用出ません。

[hatena19]

連番が保証されているなら、前のコメントの方法が高速でしょう。さらに、配列を使用するとより高速になります。
連番が保証されていない、抜けがあるなどなら、Dictionaryオブジェクトと配列を使うのが高速です。

[andrehisamoto]

皆様、お返事できておらず大変申し訳ございません。
突発的な出張が重なり本日帰宅いたしました。
今からいろいろと試してみますので今しばらくお待ちいただけると幸いです。。。

[andrehisamoto]

>okakemetalさん
理解あっております。
アドバイスありがとうございます！！
配列がいまいち理解できておらず絶賛勉強中でございまして...
とはいえ、流れはなんとなくですが理解できました！
ありがとうございます！

[andrehisamoto]

>pig_vbaさん
おっしゃる通りで、とんちんかんな場所に転記されており見逃しておりました(;´д｀)トホホ
棚卸結果の項番は被り無しでございます。

[andrehisamoto]

>tatsu99さん
連番で作成されており、抜け無しです。
その発想は全くございませんでした...
アドバイスありがとうございます！

[andrehisamoto]

>hatena19さん
配列...やはり処理速度のことを考えると必須ですね...
項番に抜けがある場合のアドバイスについてもありがとうございます！

Answer 1

マスターの項番が必ず１から始まる連番で抜けはなし。
棚卸結果の項番はマスターと一対一で対応していて、重複や抜けはない。
上記が保証されいる場合のコード例

Public Sub Sample()
    Dim aryResult(), aryMaster()
    With Workbooks("棚卸結果.xlsx").Worksheets(1)
        aryResult = .Range(.Cells(2, 1), .Cells(Rows.Count, "D").End(xlUp)).Value
    End With
    ReDim aryMaster(1 To UBound(aryResult), 1 To 2)
    
    Dim i As Long, n As Long
    For i = 1 To UBound(aryResult)
        n = aryResult(i, 4)
        aryMaster(n, 1) = aryResult(i, 1)
        aryMaster(n, 2) = aryResult(i, 2)
    Next
    
    Workbooks("マスタ.xlsx").Worksheets(1).Range("C2").Resize(UBound(aryMaster), 2).Value = aryMaster
End Sub

40万行とデータ数が多いので配列を使って高速化してます。
大量のデータを高速に処理するには配列の利用は必須ですので、 「VBA 配列 高速化」などのキーワードで検索すると解説ページが多数見つかりますので、それで研究してください。

追記

棚卸結果の項番がマスターの方に存在しない場合のエラー対策を追加

Public Sub Sample2()
    Dim aryResult(), aryMaster()
    With Workbooks("棚卸結果.xlsx").Worksheets(1)
        aryResult = .Range(.Cells(2, 1), .Cells(Rows.Count, "D").End(xlUp)).Value
    End With
    ReDim aryMaster(1 To UBound(aryResult), 1 To 2)
    
    Dim i As Long, n As Long
    For i = 1 To UBound(aryResult)
        n = aryResult(i, 4)
        If n > 0 And n <= UBound(aryMaster) Then
            aryMaster(n, 1) = aryResult(i, 1)
            aryMaster(n, 2) = aryResult(i, 2)
        Else
            Debug.Print "エラー行番号: " &  i + 1
        End If
    Next
    
    Workbooks("マスタ.xlsx").Worksheets(1).Range("C2").Resize(UBound(aryMaster), 2).Value = aryMaster
End Sub

棚卸結果の項番がマスターの方に存在しない場合は、イミディエイトウィンドウにその行番号を出力するようしました。

Comments

[andrehisamoto]

n = aryResult(i, 4)
aryMaster(n, 1) = aryResult(i, 1)
の部分で「実行時エラー：9」インデックスが有効範囲にありません。
と出てきます。
ブック名、シート名は合っていることを確認いたしました。
となると配列の指定？に関わる部分で私が認識を間違えている可能性が大ですかね？
ちょっと研究してきます。。。

[hatena19]

原因としては、棚卸結果の棚番が、マスターの方に存在しないと、そのエラーになりますね。
そういう場合があるなら、その対策が必要ですね。
対策を追加したコード例も追記しておきますので、参考にしてください。

[andrehisamoto]

ご返信出来ておらず大変申し訳ございません。

ありがとうございます！
追記いただいたもの含め、参考にさせて頂き
配列を使った改修に励んでいきたいと思います。
(配列難しい…(ヽ´ω`)ﾄﾎﾎ･･)

Answer 2

マスタの項番が１からの連番であることが保証されている場合のコードです。

Option Explicit

Public Sub ブック間転記()
'ループ用の変数
    Dim m As Long
    Dim row1 As Long        'マスタ C,D列へ書き込む行番号
    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim kouban As Variant
    Dim flag As Boolean
    Dim err_count As Long: err_count = 0
    Dim nrm_count As Long: nrm_count = 0
    Set s1 = Workbooks("マスタ.xlsx").Worksheets(1)
    Set s2 = Workbooks("棚卸結果.xlsx").Worksheets(1)
    row1 = 2
    '棚卸のシートの比較行を最終行までループ
    For m = 2 To s2.Cells(Rows.Count, 1).End(xlUp).Row
        flag = False
        kouban = s2.Cells(m, 4).Value
        If kouban <> "" Then
            If IsNumeric(kouban) = True Then
                row1 = CLng(kouban) + 1
                If row1 <= Rows.Count Then
                    If s1.Cells(row1, 1).Value = kouban Then
                        s1.Cells(row1, 3).Value = s2.Cells(m, 1).Value  '棚卸結果
                        s1.Cells(row1, 4).Value = s2.Cells(m, 2).Value  '備考
                        flag = True
                    End If
                End If
            End If
        End If
        If flag = True Then
            nrm_count = nrm_count + 1
        Else
            err_count = err_count + 1
        End If
    Next
    MsgBox ("正常処理件数=" & nrm_count & " 未処理件数=" & err_count)
End Sub

Comments

[andrehisamoto]

ネット環境が使えないような職場でして、まだ本番で試せておりませんが、似たようなものを作成し、
マクロ回してみたところ上手く転記できず...
サンプルでは全くもって問題なかったございませんでした。

原因としては、ひじょーーーーに初歩的なところでして、セルの指定の認識が間違っているなと...；；；
ここで聞いてしまって申し訳ないのと大変お恥ずかしいのですが、認識合わせをお願いしたく。

Option Explicit

Public Sub ブック間転記()
'ループ用の変数
Dim m As Long
Dim row1 As Long 'マスタ C,D列へ書き込む行番号
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim kouban As Variant
Dim flag As Boolean
Dim err_count As Long: err_count = 0
Dim nrm_count As Long: nrm_count = 0
Set s1 = Workbooks("マスタ.xlsx").Worksheets(1)
Set s2 = Workbooks("棚卸結果.xlsx").Worksheets(1)

　　　　　’↓転記する行番号
row1 = 2
'棚卸のシートの比較行を最終行までループ

　　　　　’↓検索開始行　　　　　　　↓ここの数字はどこをさしているのでしょうか...？
For m = 2 To s2.Cells(Rows.Count, 1).End(xlUp).Row
flag = False
　　　　　　　　　　　　　’↓棚卸結果の項番列
kouban = s2.Cells(m, 4).Value
If kouban <> "" Then
If IsNumeric(kouban) = True Then
row1 = CLng(kouban) + 1
If row1 <= Rows.Count Then

　　　　　　　　　　　　　　　’↓マスタ項番列
If s1.Cells(row1, 1).Value = kouban Then

　　　　　　　　　　　　　　　’↓転記先列　　　　　　↓転記元列
s1.Cells(row1, 3).Value = s2.Cells(m, 1).Value '棚卸結果
s1.Cells(row1, 4).Value = s2.Cells(m, 2).Value '備考
flag = True
End If
End If
End If
End If
If flag = True Then
nrm_count = nrm_count + 1
Else
err_count = err_count + 1
End If
Next
MsgBox ("正常処理件数=" & nrm_count & " 未処理件数=" & err_count)
End Sub

以上、何卒よろしくお願いいたします。。。

[tatsu99]

　　　　　’↓転記する行番号
row1 = 2・・・・・・これは、不要ですね。（あなたのマクロをコピーして作成した為、それが残ってました）
（但し、これがあっても動作上は特に問題はないです）

　　　　　’↓検索開始行　　　　　　　↓ここの数字はどこをさしているのでしょうか...？
For m = 2 To s2.Cells(Rows.Count, 1).End(xlUp).Row
棚卸結果の１列（A列）を指していますが、あなたのマクロでは、４列目になっています。
もし、A列とD列で最終行の判定がかわることがあるなら、D列を採用してください。
（A列に空白のセルがある場合は、最終行の判定がおかしくなります）
For m = 2 To s2.Cells(Rows.Count, 4).End(xlUp).Row
にしてください。
他の箇所はあっています。

[andrehisamoto]

先程、セル指定を修正し実行してみましたが、全て未処理件数に振り分けられてしまいました。

どこの認識を間違えているのかわからず…

何度もお手数をお掛けして恐縮ですが、見てもらえないでしょうか…？

補足:
マスタ項番セル: B5~B400000
棚卸し項番セル: BJ5~BJ400000

マスタ転記先: BI5~ , BJ5~
棚卸し転記元: C5~ , D5~

Option Explicit

Public Sub ブック間転記()
'ループ用の変数
Dim m As Long
Dim row1 As Long 'マスタ C,D列へ書き込む行番号
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim kouban As Variant
Dim flag As Boolean
Dim err_count As Long: err_count = 0
Dim nrm_count As Long: nrm_count = 0
Set s1 = Workbooks("マスタ.xlsx").Worksheets(1)
Set s2 = Workbooks("棚卸結果.xlsx").Worksheets(1)
row1 = 5
'棚卸のシートの比較行を最終行までループ
For m = 5 To s2.Cells(Rows.Count, 62).End(xlUp).Row
flag = False
kouban = s2.Cells(m, 62).Value
If kouban <> "" Then
If IsNumeric(kouban) = True Then
row1 = CLng(kouban) + 1
If row1 <= Rows.Count Then
If s1.Cells(row1, 2).Value = kouban Then
s1.Cells(row1, 61).Value = s2.Cells(m, 3).Value '棚卸結果
s1.Cells(row1, 62).Value = s2.Cells(m, 4).Value '備考
flag = True
End If
End If
End If
End If
If flag = True Then
nrm_count = nrm_count + 1
Else
err_count = err_count + 1
End If
Next
MsgBox ("正常処理件数=" & nrm_count & " 未処理件数=" & err_count)
End Sub

[tatsu99]

row1 = CLng(kouban) + 1
を
row1 = CLng(kouban) + 4
に変えてください。

[andrehisamoto]

ご返信出来ておらず大変申し訳ございません。

お陰様で問題なく転記出来ました。
この度は誠にありがとうございましたっっ！！