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万行ほど

マスタ例↓
![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2022-11-01/09de18a0-8fd6-4b27-ab7e-fc58f7227737.png)

棚卸結果例↓
![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2022-11-01/4d8644f5-f1d7-4efc-b78f-1bf42286c260.png)

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

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

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

Accepted Answer

マスタの項番が１からの連番であることが保証されている場合のコードです。
```VBA
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

```

Answer

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

```vba
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 配列 高速化」などのキーワードで検索すると解説ページが多数見つかりますので、それで研究してください。

追記
---
棚卸結果の項番がマスターの方に存在しない場合のエラー対策を追加
```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
```
棚卸結果の項番がマスターの方に存在しない場合は、イミディエイトウィンドウにその行番号を出力するようしました。