Excel VBA 並び替えと、Findの組み合わせでループ処理速度を改善する

高速化

膨大なループや処理により重たい、遅いVBAの処理を並び替えとFindの検索を組み込むことで、ループ回数を減らし処理速度を改善する方法をご紹介します。

高速な構文を使用するのではなく、処理(ロジック)の改善をするという事です。

ループの回数が多いと、その分確実に処理時間は長くなります。

並び替えと組み合わせて少しでもループの回数を減らして、無駄なループと処理を減らす方法です。

今回の速度検証結果を先にお伝えしますと、「1/3」程度しか高速になりませんでした・・・。

ループに1分かかっている処理であれば20秒と確かに効果はありますが、ちょっと想定以下でした。

それでも「1/3」の改善をお考えの方は参考程度にご覧ください。

ループの基本的な使い方や、その他の高速化については下記記事をご覧ください。

1.ループ回数を減らすロジック

説明の前に今回の方法は何の条件もなしに、最終行までループする処理には使えませんのでご注意ください。

それではループ回数を減らすロジックについて説明したいと思います。

処理を行うための条件となる列で並び替えを行います。

並び替えを行う事で条件となるキーワードが連続したデータの並びになってくれますので、条件を満たすデータの領域のみループできるようになります。

条件を満たさなくなったらループを離脱してしまえば、それ以上のループを削減出来ます。

さらに開始行を「Findメソッド」で取得することで、必要な領域のみをループする事が可能になります。

数行では一瞬の話ですが、これが何万回となった場合や、何度も繰り返される場合は非常に大きな差になります。

では、よりイメージしやすいように、少し具体的な話で説明したいと思います。

具体例

次のようなランダムな並んだA列に日付、B列に売上があるデータが10万行あったとします。

ランダムな並びのデータから、A列の日付が「2019/9/10」のデータの売上だけを加算する処理をした場合を考えて見たいと思います。

どこに条件となる日付が存在するかわからないため、最終行までループする必要があります。

「Sumif関数」使えよというツッコミはなしでお願いします。

このようなループ処理のケースで、日付を軸に並び替えする事で、日付が連続したデータとなります。

条件となる日付を見つけた位置から、日付が変わる位置までループするだけで良くなります。

それでは並び替えの方法と、Findメソッドの使い方、ループ処理の方法を順に説明したいと思います。

2.並び替え方法

まずは並び替え方法です。

簡単な説明になりますので、詳細は「Sort(ソート)でデータを並び替えする」をご覧ください。

複数条件で並び替えをする場合は「複数条件でSort(ソート)で並び替えする」をご覧ください。

条件をクリア

並び替えをする前にあらかじめ条件をクリアします。

前回手段や、VBAで指定した並び替え条件が保存されて残っている可能性があるからです。

クリアするには「SortFieldオブジェクト」を使用して次のように記述します。

ActiveSheet.Sort.SortFields.Clear

注意点として、並び替えはアクティブシートに依存するためを「ActiveSheet」を省略しない事です。

条件を指定する

条件をクリアしたら、次は条件を指定します。

「Sort.SortFields.Add」で条件を追加して、各引数で並び替えの詳細を設定します。

下記コードが条件指定の基本となりますので、こちらも覚えておいた方が良いです。

ActiveSheet.Sort.SortFields.Add _
            Key:=ActiveSheet.Cells(1, 1), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
引数一覧
引数名必須/省略説明
Key必須並べ替えの基準セルを指定します。
SortOn省略可能並べ替えのタイプを指定します。
Order省略可能並べ替えの順序を指定します。
CustomOrder省略可能ユーザー設定の並べ替え順序を指定します。
DataOption省略可能数値と文字列の並べ替え基準を指定します。

条件で並び替えする

条件を指定したら、最後は「Sortオブジェクト」で並び替えをします。

「SetRange」で並び替えをするデータ範囲を指定します。

「Apply」で指定した条件で並び替えを実行します。

With ActiveSheet.Sort
            .SetRange Range(Cells(1, 1), Cells(10, 3))
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
引数一覧
引数名必須/省略説明
Header省略可能先頭行をタイトルにするか指定します。
MatchCase省略可能大文字と小文字を区別するか指定します。
Orientation省略可能並び替えの方向を指定します。
SortMethod省略可能ふりがなを使うか指定します。

サンプルコード

先ほどの10万行のデータをA列の日付を昇順で並び替えるサンプルコードです。

コードの説明はコード内のコメントをご覧ください。

Sub Sample1()

Dim MaxRow As Long

With ActiveSheet 'アクティブシートを指定

    MaxRow = Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
    
    .Sort.SortFields.Clear '並び替え条件
    
    .Sort.SortFields.Add _
        Key:=ActiveSheet.Cells(1, 1), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal '条件を指定
        
    With .Sort '指定した条件で並び替え
        .SetRange Range(Cells(1, 1), Cells(MaxRow, 2)) 'A1～B100001を指定
        .Header = xlYes '項目列があるか指定
        .MatchCase = False '大文字小文字を区別しない
        .Orientation = xlTopToBottom '行方向に並び替え
        .SortMethod = xlPinYin 'フリガナを使う
        .Apply
        
    End With
    
End With

End Sub

日付順に並び替えできました。

3.Findメソッドで検索した行を取得する

Findメソッドで検索した結果の行を取得する事が可能です。

基本的にFindメソッドは上から順に探していき、一番最初に見つけたセルを返します。

このため、並び替えを行っているデータでFindメソッドを使用すると条件に一致する最初の行を取得する事が出来ます。

Findメソッドは引数も多く、ここでは詳細な説明は割愛します。

Findメソッドの詳細について「Find、FindNextで文字列を検索する方法」をご覧ください。

とりあえず条件に一致した行を取得するコードは次のように記述します。

Find("検索条件").Row

4.並び替えとFindをループと組み合わせる

並び替えとFindメソッド、ループを組み合わせたコードです。

並び替えをしない場合と処理速度を比較するため、並び替えした場合と、並び替えしない場合の両方のコードを記述したいと思います。

A列の日付が「2019/9/10」の日付の売上を合計するコードです。

並び替えとFindメソッドを使わない場合のコード

コードの説明はコメントをご覧ください。

Sub Sample2()

Dim i       As Long
Dim MyDate  As Date
Dim MySum   As Long
Dim MaxRow  As Long

MyDate = "2019/9/10" '条件の日付

With ActiveSheet 'アクティブシートを指定

    MaxRow = Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
    
    For i = 2 To MaxRow '2行目から
    
        If .Cells(i, 1) = MyDate Then '日付が条件と一致するか判定
        
            MySum = MySum + .Cells(i, 2) '一致した場合は売上を加算
        
        End If
    
    Next i
    
End With

End Sub

合計と処理時間です。

「0.914秒」でした。

もっと時間がかかることを見込んで10万行としたのですが、ちょっと早すぎですね。

並び替えとFindメソッドを組み込んだコード

並び替えとFindを組み込んだコードです。

Sub Sample3()

Dim i       As Long
Dim MyDate  As Date
Dim MySum   As Long
Dim MaxRow  As Long
Dim TrRow   As Long

MyDate = "2019/9/10"
MySum = 0

With ActiveSheet 'アクティブシートを指定

    MaxRow = Cells(Rows.Count, 1).End(xlUp).Row '最終行を取得
    
    .Sort.SortFields.Clear '並び替え条件
    
    .Sort.SortFields.Add _
        Key:=ActiveSheet.Cells(1, 1), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal '条件を指定
        
    With .Sort '指定した条件で並び替え
        .SetRange Range(Cells(1, 1), Cells(MaxRow, 2)) 'A1～B100001を指定
        .Header = xlYes '項目列があるか指定
        .MatchCase = False '大文字小文字を区別しない
        .Orientation = xlTopToBottom '行方向に並び替え
        .SortMethod = xlPinYin 'フリガナを使う
        .Apply
        
    End With
    
    '検索行を取得する
    TrRow = Range(.Cells(2, 1), .Cells(MaxRow, 1)).Find(MyDate).Row
    
    For i = TrRow To MaxRow '2行目から最終行までループ
    
        If .Cells(i, 1) = MyDate Then '日付が条件と一致するか判定
    
            MySum = MySum + .Cells(i, 2) '一致した場合は売上を加算
            
            If .Cells(i + 1, 1) <> MyDate Then Exit For '一つ下のセルの日付が異なった場合は離脱
        
        End If
    
    Next i
    
End With

End Sub

「0.343秒」でした。

1/3にも満たない改善結果となりましたが、単純な足し算ではなくもっと時間のかかる処理の場合はこの差は大きくなります。

ちょっとしたロジックの改善で、処理速度が変わりますのでぜひ工夫してみてください。

スポンサーリンク
タイトルとURLをコピーしました