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

いろんなやり方があるみたいだが、大量データとなった場合は、Findメソッドを使うか

Valiantの配列にセルの情報を格納（メモリに展開）するパターンが早いらしい。

以下の例は、仮にA〜N行に大量データ(20000行程度)があるシート1（JIGYOSYO）とシート２(JIGYOSYO2)の情報（C行）が、各々のシートのどこにあるかをチェックするロジック

チェック結果は各々のシートのO行に、チェック先の行番号を転記させる。

また、高速化もしたいが、進捗状況も知りたいので、doeventsも活用。

もっとエレガントで高速なロジックがあるのかもしれないので、まだまだ調査だ。

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

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