Excel VBA で3万行と3万行を付きあわせる処理を短時間でやりたい。配列？

Question

Excel VBA で3万行と3万行を付きあわせる処理を短時間でやりたい。

sheet1のA列に3万行の会員番号があります。
sheet2のA列にも同じく3万行の会員番号があります。

[やりたいこと]
sheet1のA1から順番にsheet2のA1:A30000までを突き合わせる処理をしたいのです。
つまり、30000回*30000回の突き合わせが発生します。
こういう処理は配列でやると一瞬だ、という話を聞いて初心者なりにコードを書いてみたのですが
なぜか途方もない時間がかかります。
ちなみに、"突き合わせて何をするか"は様々なパターンがありまして、とりあえず突き合わせの部分を高速にしないことには実務で使えない状況です。

[試したこと]
'変数Range1 にはsheet1のA1:A30000がRange型として入ってます。
'変数Range2 にはsheet2のA1:A30000がRange型として入ってます。

'ﾃﾞｰﾀﾚﾝｼﾞ取得し配列へ代入
Dim arr1 As Variant '
Dim arr2 As Variant '仮納品ﾃﾞｰﾀﾚﾝｼﾞ用配列
Set arr1 = Range1
Set arr2 = Range2
'ｶｳﾝﾄ
Dim rep() As Integer 'ｶｳﾝﾄ結果代入用の配列変数を用意
ReDim rep(arr1.Count)
'ｶｳﾝﾄ
Dim tmp As Variant
Dim i As Long
Dim j As Long
Dim cnt As Integer 'ｶｳﾝﾄ
For i = 1 To arr1.Count
For j = 1 To arr2.Count
If arr1(i) = arr2(j) Then
cnt = cnt + 1
End If
Next j
rep(i) = cnt
cnt = 0
Next i
'ｶｳﾝﾄ結果をｾﾙへ貼付
Range1.Offset(0, 1) = rep

Answer 1

某有名なエクセルの先生が、「エクセルはワークシートがあるのでいちいち小難しい連想配列なんて使わないよ。」とおっしゃっていましたが、違うようですね。

どの先生かは知りませんが、たぶん、ワークシート関数を使えば簡単かつ高速にできることがある、という意味でいっているだと推測。

今回の案件なら、
Sheet1 の B1 に下記の式を設定して

=COUNTIF(Sheet2!$A$1:$A$30000,Sheet1!A1)

これをフィルダウンすれば結果が表示されます。

これをVBA化すると下記のようになります。

Sub Sumple()
    With Sheet1.Range("A1:A30000").Offset(0, 1)
        .Formula = "=COUNTIF(Sheet2!$A$1:$A$30000,Sheet1!A1)"
        .Value = .Value '式を値に変換
    End With
End Sub

速度はどの程度になるかは分かりませんが、セルを一つずつ参照して計算するよりはるかに高速なはずです。

Answer 2

標準機能を使用して行う場合、Power Queryの利用が考えられます。
Power Queryで複数シートの結合

面倒だなと感じるようであれば、シートをDBのテーブルとして扱い、SQL操作を可能にする方法で行ってみて下さい。
Excelの集計をSQLでおこなう方法。VLOOKUP()やSUBTOTAL()の限界を超えろ！！

応用を考えた時は後者が断然お薦めです。

Answer 3

Rangeを配列に移しているつもりで、移した先もRange型になってしまっています。

Sub test()
    '変数Range1 にはsheet1のA1:A30000がRange型として入ってます。
    '変数Range2 にはsheet2のA1:A30000がRange型として入ってます。
    Dim Range1 As Range, Range2 As Range
    Set Range1 = Sheet1.Range("A1:A30000")
    Set Range2 = Sheet2.Range("A1:A30000")
    
    'ﾃﾞｰﾀﾚﾝｼﾞ取得し配列へ代入
    Dim arr1 As Variant        '
    Dim arr2 As Variant       '仮納品ﾃﾞｰﾀﾚﾝｼﾞ用配列
    arr1 = Range1
    arr2 = Range2
    
    'ｶｳﾝﾄ
    Dim rep() As Integer    'ｶｳﾝﾄ結果代入用の配列変数を用意
    ReDim rep(1 To Range1.Count, 1 To 1)
    
    
    'ｶｳﾝﾄ
    Dim tmp As Variant
    Dim i As Long
    Dim j As Long
    Dim cnt As Integer       'ｶｳﾝﾄ
    For i = 1 To Ubound(arr1, 1)
        For j = 1 To Ubound(arr2, 1)
            If arr1(i, 1) = arr2(j, 1) Then
                cnt = cnt + 1
            End If
            DoEvents
        Next j
        rep(i) = cnt
        cnt = 0
    Next i
    'ｶｳﾝﾄ結果をｾﾙへ貼付
    Range1.Offset(0, 1) = rep

End Sub

---

＜追記＞
上記のように配列に代入しても、大量データ同志の二重ループだとどうしても遅くなります。
また、やりたいことによっては、必ずしも配列にするのが正解とも限らないと思います。
たとえば、以下はワークシート関数を利用してみたものです。

Sub test2()
    Dim Range1 As Range, Range2 As Range
    Set Range1 = Sheet1.Range("A1:A30000")
    Set Range2 = Sheet2.Range("A1:A30000")

    Dim rep()
    ReDim rep(1 To Range1.Count, 1 To 2)

    Dim i As Long
    For i = 1 To Range1.Count
        
        rep(i, 1) = WorksheetFunction.CountIf(Range2, Range1(i, 1))             'Sheet2でのカウント結果
        If rep(i, 1) > 0 Then
            rep(i, 2) = WorksheetFunction.Match(Range1(i, 1), Range2, False)    'Sheet2の（最初にマッチした）行番号
        End If
    Next i
    
    Range1.Offset(0, 1).Resize(, 2) = rep

End Sub

---

また、こちらは連想配列を使った例です。

Sub test3()
    '変数Range1 にはsheet1のA1:A30000がRange型として入ってます。
    '変数Range2 にはsheet2のA1:A30000がRange型として入ってます。
    Dim Range1 As Range, Range2 As Range
    Set Range1 = Sheet1.Range("A1:A30000")
    Set Range2 = Sheet2.Range("A1:A30000")

    'ﾃﾞｰﾀﾚﾝｼﾞ取得し配列へ代入
    Dim arr1 As Variant        '
    Dim arr2 As Variant       '仮納品ﾃﾞｰﾀﾚﾝｼﾞ用配列
    arr1 = Range1
    arr2 = Range2

    'ｶｳﾝﾄ
    Dim rep() As Integer    'ｶｳﾝﾄ結果代入用の配列変数を用意
    ReDim rep(1 To Range1.Count, 1 To 1)


    'ｶｳﾝﾄ
    Dim tmp As Variant
    Dim i As Long
    Dim j As Long
    Dim d
    Set d = CreateObject("Scripting.Dictionary")
    For j = 1 To UBound(arr2, 1)
        d(arr2(j, 1)) = d(arr2(j, 1)) + 1
    Next
    
    For i = 1 To UBound(arr1, 1)
        If d.Exists(arr1(i, 1)) Then
            rep(i, 1) = d(arr1(i, 1))
        End If
    Next i
    'ｶｳﾝﾄ結果をｾﾙへ貼付
    Range1.Offset(0, 1) = rep

End Sub

Comments

[access]

セル範囲をVariant型変数へ代入すると配列になるとネットで調べたのですが違いましたか・・・。
arr1とarr2の宣言を以下のように書き換えて試してみます。ありがとうございます。
Dim arr1() as variant
redim arr1(Range1.count)

[jinoji]

セル範囲をVariant型変数へ代入すると配列になる、はその通りですが、
Set arr1 = Range1 とやると、arr1もRange型になってしまいます。
arr1 = Range1 （丁寧にやると arr1 = Range1.Value ですが）とやると、意図したものになります。

[access]

そういうことだったのですが、添削して頂いていたコードを確認いたしました。
セル1列を配列に入れても二次元配列になるのですね。とにかくやってみます！有難うございます！

[jinoji]

まあ、それでも今のコードのまま30000×30000だとかなり遅いと思います。
TanakaHiroakiさんがいうように連想配列にするのがよいと私も思います。

[access]

ご回答いただいた方法でとりあえずできました！
ただ、速さは1割短縮といったところでした。連想配列について勉強してみます。
ありがとうございます。

[access]

連想配列のコード有難うございます。
1分40秒かかっていた処理がなんと1秒かからず終わりました。
今の業務でこういった件数の突き合わせ処理が頻繁に発生しますので必ず習得しようと思います。
某有名なエクセルの先生が、「エクセルはワークシートがあるのでいちいち小難しい連想配列なんて使わないよ。」とおっしゃっていましたが、違うようですね。

Answer 4

更に高速化するために連想配列の使い方を覚えると良いです。
Dictionary オブジェクト（連想配列） とは ビッグデータ高速処理を可能にする技 (Excel VBA)