転記 配列版

Sub CopyIfChanged_ScheduleToBKURecord_Array_Fixed()
    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim srcData As Variant, dstData As Variant, copyData() As Variant
    Dim srcRow As Long, dstRow As Long, i As Long, j As Long
    Dim lastDstRow As Long, dstCount As Long
    Dim matchRow As Long, isDifferent As Boolean, found As Boolean
    
    ' シート設定
    Set wsSrc = ThisWorkbook.Worksheets("スケジュール")
    Set wsDst = ThisWorkbook.Worksheets("BKURecord")
    
    ' スケジュール(B～H列 4～53行)を配列に格納
    srcData = wsSrc.Range("B4:H53").value
    
    ' BKURecord(B～H列 4～1003行)を配列に格納
    dstData = wsDst.Range("B4:H1003").value
    
    ' BKURecord の最終行を取得（C列基準）
    lastDstRow = wsDst.Cells(wsDst.Rows.count, "C").End(xlUp).row
    If lastDstRow < 4 Then lastDstRow = 3
    
    ' 転記用配列（最大50件想定で仮確保）
    ReDim copyData(1 To 50, 1 To 7)
    dstCount = 0
    
    ' スケジュールを1行ずつチェック
    For i = 1 To UBound(srcData, 1)
        If Trim(srcData(i, 2)) <> "" Then ' C列に値あり
            
            found = False
            matchRow = 0
            
            ' BKURecord内で一致するC列を検索
            For j = 1 To (lastDstRow - 3)
                If Trim(dstData(j, 2)) = Trim(srcData(i, 2)) Then
                    found = True
                    matchRow = j
                    Exit For
                End If
            Next j
            
            If Not found Then
                ' 一致なし → 新規転記対象
                dstCount = dstCount + 1
                For j = 1 To 7
                    copyData(dstCount, j) = srcData(i, j)
                Next j
            Else
                ' 一致あり → D～H列を比較（4～8列）
                isDifferent = False
                For j = 3 To 7
                    If srcData(i, j) <> dstData(matchRow, j) Then
                        isDifferent = True
                        Exit For
                    End If
                Next j
                
                ' 値が異なる場合のみ転記
                If isDifferent Then
                    dstCount = dstCount + 1
                    For j = 1 To 7
                        copyData(dstCount, j) = srcData(i, j)
                    Next j
                End If
            End If
        End If
    Next i
    
    ' 転記処理（1件以上ある場合のみ）
    If dstCount > 0 Then
        dstRow = lastDstRow + 1
        wsDst.Range("B" & dstRow & ":H" & dstRow + dstCount - 1).value = _
            Application.Index(copyData, Evaluate("ROW(1:" & dstCount & ")"), Array(1, 2, 3, 4, 5, 6, 7))
        MsgBox "転記済み (" & dstCount & " 件)", vbInformation
    Else
        MsgBox "転記なし", vbInformation
    End If
End Sub