【Excel VBA】処理が早いのはどれ?250万個の中から一致するものをすべて抽出するマクロ3種

Excel

「一致するものをすべて取り出したい」〜 エクセルを使うときによくある状況。

5000 x 5000 のセルの中の数値から、任意の1つの数と一致するものをすべて抽出するときのマクロを3パターン考えてみた。果たしてどのマクロの処理速度が一番早いか。

処理する内容

処理内容は至ってシンプル。

5000行 x 5000列=25,000,000セルに入力されたランダムな数値(今回は1〜3000の数とした)がある。パッと思いついた任意の1つの数字(今回は2999)をこの中から探し出して、そのすべての行番号と列番号を取り出す。

実験に使用した表。スクリーンショットのためにウィンドウ枠を固定している。

この処理をおこなうマクロを3パターン用意した。皆さんなら処理内容を聞いてますどれを思いつくだろうか。

  1. セルを巡回して比較しながら抽出
    一番左上のセルからFor~Nextのループを使って巡回し、Ifで一致・不一致を判断。
  2. すべてのセル値を二次配列に読み込んでから比較抽出
    5000 x 5000セルを二次配列として読み込んで、配列内をFor~Nextのループを使って巡回し、Ifで一致・不一致を判断。
  3. 検索機能を使ってヒットしたものを抽出
    Find、FindNextでヒットする値がなくなるまでDo~Loopを使って繰り返す。

そして果たして、どのパターンが一番早く処理できるのか。検証スタートです。

なお今回の3パターンのマクロ(プロシージャ)は1つのモジュールに記述し、モジュールの先頭に定数として検索値を設定している。

検索値はモジュールレベルの定数として指定した。各プロシージャ内にfNumとしていきなり出てくるので注意。

マクロ1 セルを巡回して比較しながら抽出

Sub Sample1()
'    セルの値を順に比較して抽出
    Dim tm1 As Date
    tm1 = Format(Now(), "hh:mm:ss")
    Debug.Print "Sample 1 -----------------"
    Debug.Print "Start: " & tm1
    
    Sheets("Sheet2").Cells.ClearContents
    
    Dim quantity As Long
    quantity = WorksheetFunction.CountIf(Range("B2:GJI5001"), fNum)
    
    Dim extractValues() As Variant
    ReDim extractValues(1 To quantity, 1 To 2)
    
    Dim r As Long, c As Long, i As Long
    i = 1
    For c = 2 To 5001
        For r = 2 To 5001
            If Cells(r, c) = fNum Then
                extractValues(i, 1) = Cells(r, 1)
                extractValues(i, 2) = Cells(1, c)
                i = i + 1
            End If
        Next r
    Next c
    
    Sheets("Sheet2").Range("A1:B" & quantity) = extractValues
    
    Dim tm2 As Date
    tm2 = Format(Now(), "hh:mm:ss")
    Debug.Print "End: " & tm2
    Debug.Print i & " values match"
    Debug.Print DateDiff("s", tm1, tm2) & " seconds needed."
End Sub

マクロ2 すべてのセル値を二次配列に読み込んでから比較抽出

Sub Sample2()
'    二次配列に読み込んだセル値を比較して抽出
    Dim tm1 As Date
    tm1 = Format(Now(), "hh:mm:ss")
    Debug.Print "Sample 2 -----------------"
    Debug.Print "Start: " & tm1
    
    Sheets("Sheet3").Cells.ClearContents
    
    Dim targetRange As Range
    Set targetRange = Range("B2:GJI5001")
    
    Dim targetValues As Variant
    targetValues = targetRange.Value
    
    Dim quantity As Long
    quantity = WorksheetFunction.CountIf(targetRange, fNum)
    
    Dim extractValues() As Variant
    ReDim extractValues(1 To quantity, 1 To 2)
    
    Dim r As Long, c As Long, i As Long
    i = 1
    For c = 1 To 5000
        For r = 1 To 5000
            If targetValues(r, c) = fNum Then
                extractValues(i, 1) = Cells(r + 1, 1)
                extractValues(i, 2) = Cells(1, c + 1)
                i = i + 1
            End If
        Next r
    Next c
    
    Sheets("Sheet3").Range("A1:B" & quantity) = extractValues
    
    Dim tm2 As Date
    tm2 = Format(Now(), "hh:mm:ss")
    Debug.Print "End: " & tm2
    Debug.Print i & " values match"
    Debug.Print DateDiff("s", tm1, tm2) & " seconds needed."
End Sub

マクロ3 検索機能を使ってヒットしたものを抽出

Sub Sample3()
'    エクセルの検索機能を使って抽出
    Dim tm1 As Date
    tm1 = Format(Now(), "hh:mm:ss")
    Debug.Print "Sample 3 -----------------"
    Debug.Print "Start: " & tm1
    
    Sheets("Sheet4").Cells.ClearContents
    
    Dim targetRange As Range
    Set targetRange = Range("B2:GJI5001")
    
    Dim quantity As Long
    quantity = WorksheetFunction.CountIf(targetRange, fNum)
    
    Dim extractValues() As Variant
    ReDim extractValues(1 To quantity, 1 To 2)
    
    Dim matchRange As Range
    Dim orgAdd As String
    Dim i As Long
    Set matchRange = targetRange.Find(What:=fNum, LookIn:=xlValues)
    If Not matchRange Is Nothing Then
        orgAdd = matchRange.Address
        i = 1
        Do
            extractValues(i, 1) = Cells(matchRange.Row, 1)
            extractValues(i, 2) = Cells(1, matchRange.Column)
            Set matchRange = targetRange.FindNext(After:=matchRange)
            i = i + 1
        Loop Until matchRange.Address = orgAdd
    Else
        Debug.Print "none."
    End If
    
    Sheets("Sheet4").Range("A1:B" & quantity) = extractValues
    
    Dim tm2 As Date
    tm2 = Format(Now(), "hh:mm:ss")
    Debug.Print "End: " & tm2
    Debug.Print i & " values match"
    Debug.Print DateDiff("s", tm1, tm2) & " seconds needed."
End Sub

検証の結果

結果は次の通り。あっさりとまとめてどうぞ。

マクロ1は70秒、マクロ2が8秒、マクロ3は45秒という結果になった。

一旦すべてのセルを配列として読み込むマクロ2が一番早い、という結果は大方予想通りだったと思う。

しかし、意外にも検索機能は健闘するものだと思ったのは僕だけだろうか。
割とパッと一番最初に思いつきそうなマクロ1が圧倒的ダントツに遅かったのでした。

皆さんの予想は当たりましたか?

コメント

タイトルとURLをコピーしました