【EXCEL VBA】シート間の相互相関チェック処理例（大量データ時）

ExcelのVBAを使用して、2つのシート（JIGYOSYOとJIGYOSYO2）間で大量データ（約20,000行）のC列の値の相互相関をチェックし、一致した行番号を相互のO列に転記する処理のサンプルコードです。

想定環境・前提条件

• Microsoft Excel 2010以降（VBA実行環境）
• 対象シート名：「JIGYOSYO」「JIGYOSYO2」
• データ範囲：A1〜O21660（検索キーはC列、結果出力はO列）

Findメソッドを使った高速検索の例（相互相関チェック2）

ループ内でFindメソッドを利用し、一致するセルを検索して行番号を相互に書き込む方式です。

Sub 相互相関チェック2()
    Dim CompareRange1 As Range
    Dim FirstCell As Range, FoundCell As Range
    Dim Target As Range
    Dim CompareRange2 As Range
    Dim tmp As Range
    
    Set CompareRange1 = ThisWorkbook.Sheets("JIGYOSYO").Range("C1:C21660") '検索キー部
    Set CompareRange2 = ThisWorkbook.Sheets("JIGYOSYO2").Range("C1:C21660") '検索キー部
    
    Dim d As Date
    d = Now
    
    For Each tmp In CompareRange2
        Application.StatusBar = tmp.Row
        DoEvents
        Set FoundCell = CompareRange1.Find(What:=tmp.Value)
        If FoundCell Is Nothing Then
            Exit For
        Else
            ThisWorkbook.Sheets("JIGYOSYO").Range("O" & FoundCell.Row).Value = tmp.Row
            ThisWorkbook.Sheets("JIGYOSYO2").Range("O" & tmp.Row).Value = FoundCell.Row
        End If
    Next tmp
    
    For Each tmp In CompareRange1
        Application.StatusBar = tmp.Row
        DoEvents
        Set FoundCell = CompareRange2.Find(What:=tmp.Value)
        If FoundCell Is Nothing Then
            Exit For
        Else
            ThisWorkbook.Sheets("JIGYOSYO2").Range("O" & FoundCell.Row).Value = tmp.Row
            ThisWorkbook.Sheets("JIGYOSYO").Range("O" & tmp.Row).Value = FoundCell.Row
        End If
    Next tmp
    
    MsgBox "start=" & d & " end=" & Now & " 実行時間：" & DateDiff("s", d, Now) & "秒"
End Sub

配列展開による処理例（相互相関チェック）

Variant型の配列にシート上のデータを一度に読み込み、メモリ上で比較を行った後に一括書き戻しを行う方式です。

Sub 相互相関チェック()
    Dim CompareRange1 As Variant, x As Variant, y As Variant
    Dim CompareRange2 As Variant
    
    Dim d As Date
    d = Now
    CompareRange1 = ThisWorkbook.Sheets("JIGYOSYO").Range("A1:O21660") '検算結果領域までコピー（O行:15行目）
    CompareRange2 = ThisWorkbook.Sheets("JIGYOSYO2").Range("A1:O21660") '検算結果領域までコピー（O行:15行目）
    
    Dim i As Long, j As Long
    Dim str1 As String
    Dim str2 As String
    
    For i = 1 To 21660
        str1 = CompareRange1(i, 3)
        
        For j = 1 To 21660
            str2 = CompareRange2(j, 3)
            If str1 = str2 Then
                CompareRange1(i, 15) = j
                CompareRange2(j, 15) = i
                Application.StatusBar = i & " " & j
                DoEvents
            End If
        Next j
    Next i
    
    ThisWorkbook.Sheets("JIGYOSYO").Range("A1:O21660") = CompareRange1  '検算結果領域までコピー（O行:15行目）
    ThisWorkbook.Sheets("JIGYOSYO2").Range("A1:O21660") = CompareRange2 '検算結果領域までコピー（O行:15行目）
    
    MsgBox "start=" & d & " end=" & Now & " 実行時間：" & DateDiff("s", d, Now) & "秒"
End Sub