ExcelマクロVBA技術解説 | 大量データにおける処理方法の速度王決定戦 | Excelマクロの問題点と解決策、エクセルVBAの技術的解説



最終更新日:2016-09-08

大量データにおける処理方法の速度王決定戦

VBAで自動化したが、大量データ処理に時間がかかってしまう・・・
そんな悩みが非常に多いようです、
そこで、各種処理方法の速度比較を行い、どの処理方法が最も速いかを検証します。
つまり、処理方法の速度王決定戦です。


検証する題材としては、最も一般的な集計で行います。
集計は、エクセルらしい処理の代表といえるものでしょう。

以下のようなデータ集計を行います。



キーとして、A1〜A1000まで、データとして、1〜1,000まで、これが、30回繰り返されて、合計30,000行です。
これが、シート「データ1」です。
これを、1,000*30と表記するとして、
「データ1」:1,000*30 ・・・ キー1,000件の30,000行データ
「データ2」:10,000*3 ・・・ キー10,000件の30,000行データ
「データ3」:10,000*30 ・・・ キー10,000件の300,000行データ
「データ4」:100,000*3 ・・・ キー100,000件の300,000行データ

以上の4パターンです。

これを、以下のように集計します。



キーごとにデータを集計します。
規則としては、

・出力順は問わない
・元のシートには変更を加えない
・追加したシートは削除しておく


以上の範囲内で、10通りの処理方法で、VBAを記述します。
VBAコードは、各処理方法としては速度を意識して書いたつもりです。

1.ワークシート関数を使った基本 1
2.ワークシート関数を使った基本 2
3.AdvancedFilter + SumIf 1
4.AdvancedFilter + SUMIF 2
5.ピボット + コピペ
6.配列のみで 1
7.配列のみで 2
8.Dictionary + 配列
9.Sort + 配列
10.ADO + SQL


先の4パターンのデータについて、
上記の10通りの処理時間を3回ずつ計測し平均時間を使います。
集計という題材であれば、一般的なパターンとしてはこれくらいでしょうか。
※「データ3」と「データ4」は、速度上位の処理だけ実施しました。

VBAコードの解説はほとんどしていませんので、
VBAコードについて分からない部分は、別途に調べて下さい。


検証用メインのプロシージャ

Option Explicit

Private ws1 As Worksheet
Private ws2 As Worksheet
Private sTimer As Single

Sub sample()
  Dim i As Long
  Set ws2 = Worksheets("結果")
  Set ws1 = Worksheets("データ1")
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  For i = 1 To 3
    Call sample1
    Call sample2
    Call sample3
    Call sample4
    Call sample5
    Call sample6
    Call sample7
    Call sample8
    Call sample9
    Call sample10
  Next
  Application.StatusBar = False
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

データのシート名を
「データ1」「データ2」「データ3」「データ4」
それぞれに変更して実行します。
イミディエイトウィンドウに出力されたタイムを処理ごとに平均します。
正確を期すため、1回実行したらExcelを一旦終了してから再実行しています。


1.ワークシート関数を使った基本 1

'ワークシート関数を使った基本 1
Sub sample1()
  Dim i As Long
  Dim j As Long
  ws2.Range("A1").CurrentRegion.Offset(1).Clear
  sTimer = Timer
  On Error Resume Next
  For i = 2 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    j = WorksheetFunction.Match(ws1.Cells(i, 1), ws2.Columns(1), 0)
    If Err.Number = 0 Then
      ws2.Cells(j, 2) = ws2.Cells(j, 2) + ws1.Cells(i, 2)
    Else
      Err.Clear
      j = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
      ws2.Cells(j, 1) = ws1.Cells(i, 1)
      ws2.Cells(j, 2) = ws1.Cells(i, 2)
    End If
  Next
  Debug.Print Timer - sTimer
End Sub

まずは、VBAの基本ともいえる処理方法です。
WorksheetFunction.Matchを使い、出力済のキーかどうかを判断し、
新規なら、キーを追加、既にあれば加算


2.ワークシート関数を使った基本 2

'ワークシート関数を使った基本 2
Sub sample2()
  Dim i As Long
  Dim j As Long
  ws2.Range("A1").CurrentRegion.Offset(1).Clear
  sTimer = Timer
  For i = 2 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    If WorksheetFunction.CountIf(ws2.Columns(1), ws1.Cells(i, 1)) = 0 Then
      j = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
      ws2.Cells(j, 1) = ws1.Cells(i, 1)
      ws2.Cells(j, 2) = ws1.Cells(i, 2)
    Else
      j = WorksheetFunction.Match(ws1.Cells(i, 1), ws2.Columns(1), 0)
      ws2.Cells(j, 2) = ws2.Cells(j, 2) + ws1.Cells(i, 2)
    End If
  Next
  Debug.Print Timer - sTimer
End Sub

1.ワークシート関数を使った基本 1の応用的な書き方です。
On Error Resume Nextは、出来れば使いたくないものです。
WorksheetFunction.CountIfを使い、出力済のキーかどうかを判断しています。
新規なら、キーを追加、既にあればMatchで行を探し加算


3.AdvancedFilter + SumIf 1

'AdvancedFilter + Sumif 1
Sub sample3()
  Dim i As Long
  ws2.Range("A1").CurrentRegion.Offset(1).Clear
  sTimer = Timer
  ws1.Columns(1).AdvancedFilter Action:=xlFilterCopy, _
                 CopyToRange:=ws2.Range("A1"), _
                 Unique:=True
  For i = 2 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    ws2.Cells(i, 2) = WorksheetFunction.SumIf(ws1.Columns(1), _
                          ws2.Cells(i, 1), _
                          ws1.Columns(2))
  Next
  Debug.Print Timer - sTimer
End Sub

オートフィルタの詳細設定である、AdvancedFilterを使い一気にキーをユニーク化しています。
集計は、WorksheetFunction.SumIfを使っています。


4.AdvancedFilter + SUMIF 2

'AdvancedFilter + Sumif 2
Sub sample4()
  Dim i As Long
  Dim rng As Range
  ws2.Range("A1").CurrentRegion.Offset(1).Clear
  sTimer = Timer
  ws1.Columns(1).AdvancedFilter Action:=xlFilterCopy, _
                 CopyToRange:=ws2.Range("A1"), _
                 Unique:=True
  i = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
  Set rng = ws2.Range(ws2.Range("B2"), ws2.Cells(i, 2))
  rng = "=SUMIF(" & ws1.Name & "!A:A,A2," & ws1.Name & "!B:B)"
  rng.Value = rng.Value
  Debug.Print Timer - sTimer
End Sub

3.AdvancedFilter + SumIf 1の応用版です。
AdvancedFilterを使い一気にキーをユニーク化した後、
集計は、シート上で行い、値貼り付けで計算式を消しています。


5.ピボット + コピペ

'ピボット + コピペ
Sub sample5()
  Dim i As Long
  Dim ws As Worksheet
  Dim pvc As PivotCache
  Dim pvt As PivotTable
  ws2.Range("A1").CurrentRegion.Offset(1).Clear
  sTimer = Timer
  Set ws = Sheets.Add
  Set pvc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                SourceData:=ws1.Range("A1").CurrentRegion, _
                Version:=xlPivotTableVersion14)
  Set pvt = pvc.CreatePivotTable(TableDestination:=ws.Name & "!R1C1", _
                TableName:="ピボットテーブル1", _
                DefaultVersion:=xlPivotTableVersion14)
  With pvt
    With .PivotFields("キー")
      .Orientation = xlRowField
      .Position = 1
    End With
    .AddDataField .PivotFields("データ"), "データ合計", xlSum
    .PivotSelect "キー[All]", xlLabelOnly + xlFirstRow, True
    Selection.Resize(, 2).Copy Destination:=ws2.Range("A2")
  End With
  Application.DisplayAlerts = False
  ws.Delete
  Application.DisplayAlerts = True
  Debug.Print Timer - sTimer
End Sub

集計といったらピボットというくらいに、エクセルではよく使われる機能です。
これをVBAで行っています。
作成されたピボットより、値のコピーをしています。


6.配列のみで 1

'配列のみで 1
Sub sample6()
  Dim i As Long
  Dim j As Long
  Dim ix As Long
  Dim ary
  Dim ary1()
  Dim ary2()
  Dim blnFind As Boolean
  ws2.Range("A1").CurrentRegion.Offset(1).Clear
  sTimer = Timer
  ary = ws1.Range("A1").CurrentRegion
  ix = 0
  ReDim ary1(1, ix)
  ary1(0, 0) = ary(2, 1)
  ary1(1, 0) = 0
  For i = 2 To UBound(ary, 1)
    ix = UBound(ary1, 2) + 1
    For j = 0 To UBound(ary1, 2)
      If ary1(0, j) = ary(i, 1) Then
        blnFind = True
        ix = j
        Exit For
      End If
    Next
    If ix > UBound(ary1, 2) Then
      ReDim Preserve ary1(1, ix)
      ary1(0, ix) = ary(i, 1)
      ary1(1, ix) = ary(i, 2)
    Else
      ary1(1, ix) = ary1(1, ix) + ary(i, 2)
    End If
  Next
  ReDim ary2(UBound(ary1, 2), UBound(ary1, 1))
  For i = 0 To UBound(ary1, 1)
    For j = 0 To UBound(ary1, 2)
      ary2(j, i) = ary1(i, j)
    Next
  Next
  ws2.Range(ws2.Cells(2, 1), ws2.Cells(UBound(ary2, 1) + 2, 2)) = ary2
  Debug.Print Timer - sTimer
End Sub

もう、エクセルとか関係ない、全部自分で集計します、という感じでしょうか。
配列を使い慣れていないと、書くのにちょっと苦労するかもしれません。


7.配列のみで 2

'配列のみで 2
Sub sample7()
  Dim i As Long
  Dim j As Long
  Dim ix As Long
  Dim ary
  Dim ary1() As String
  Dim ary2() As Long
  Dim ary3()
  Dim aryT
  Dim blnFind As Boolean
  ws2.Range("A1").CurrentRegion.Offset(1).Clear
  sTimer = Timer
  ary = ws1.Range("A1").CurrentRegion
  ix = 0
  ReDim ary1(ix)
  ReDim ary2(ix)
  ary1(0) = ary(2, 1)
  ary2(0) = 0
  For i = 2 To UBound(ary, 1)
    aryT = Filter(ary1, ary(i, 1))
    If UBound(aryT) < 0 Then
      ix = UBound(ary1) + 1
      ReDim Preserve ary1(ix)
      ReDim Preserve ary2(ix)
      ary1(ix) = ary(i, 1)
      ary2(ix) = ary(i, 2)
    Else
      For j = 0 To UBound(ary1)
        If ary1(j) = ary(i, 1) Then
          blnFind = True
          ix = j
          Exit For
        End If
      Next
      ary2(ix) = ary2(ix) + ary(i, 2)
    End If
  Next
  ReDim ary3(UBound(ary1), 1)
  For i = 0 To UBound(ary1)
    ary3(i, 0) = ary1(i)
    ary3(i, 1) = ary2(i)
  Next
  ws2.Range(ws2.Cells(2, 1), ws2.Cells(UBound(ary2, 1) + 2, 2)) = ary3
  Debug.Print Timer - sTimer
End Sub

6.配列のみで 1とほぼ同じなのですが、
キーが配列にすでにあるかどうかを、Filter関数を使って判断しています。


8.Dictionary + 配列

'Dictionary + 配列
Sub sample8()
  Dim myDic As New Dictionary
  Dim i As Long
  Dim j As Long
  Dim ix As Long
  Dim ary
  Dim ary1
  Dim ary2
  Dim ary3
  ws2.Range("A1").CurrentRegion.Offset(1).Clear
  sTimer = Timer
  For i = 2 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    If myDic.Exists(ws1.Cells(i, 1).Value) Then
      myDic(ws1.Cells(i, 1).Value) = myDic(ws1.Cells(i, 1).Value) _
                     + ws1.Cells(i, 2).Value
    Else
      myDic.Add ws1.Cells(i, 1).Value, ws1.Cells(i, 2).Value
    End If
  Next
  ary1 = myDic.Keys
  ary2 = myDic.Items
  Set myDic = Nothing
  ReDim ary3(UBound(ary1), 1)
  For i = 0 To UBound(ary1)
    ary3(i, 0) = ary1(i)
    ary3(i, 1) = ary2(i)
  Next
  ws2.Range(ws2.Cells(2, 1), ws2.Cells(UBound(ary3) + 2, 2)) = ary3
  Debug.Print Timer - sTimer
End Sub

Dictionary(ディクショナリー)のパフォーマンスについて
こちらで検証したものとほぼ同じです。
Dictionaryから配列に一気に取り出しています。


9.Sort + 配列

'Sort + 配列
Sub sample9()
  Dim i As Long
  Dim j As Long
  Dim ix As Long
  Dim ws As Worksheet
  Dim ary
  Dim ary1()
  Dim ary2()
  ws2.Range("A1").CurrentRegion.Offset(1).Clear
  sTimer = Timer
  ws1.Copy Before:=ActiveSheet
  Set ws = ActiveSheet
  ws.Range("A1").CurrentRegion.Sort Key1:=ws.Range("A1"), _
                   Order1:=xlAscending, _
                   Header:=xlYes
  ary = ws.Range("A1").CurrentRegion
  ix = -1
  For i = 2 To UBound(ary, 1)
    If ary(i, 1) <> ary(i - 1, 1) Then
      ix = ix + 1
      ReDim Preserve ary1(1, ix)
      ary1(0, ix) = ary(i, 1)
      ary1(1, ix) = ary(i, 2)
    Else
      ary1(1, ix) = ary1(1, ix) + ary(i, 2)
    End If
  Next
  ReDim ary2(UBound(ary1, 2), UBound(ary1, 1))
  For i = 0 To UBound(ary1, 1)
    For j = 0 To UBound(ary1, 2)
      ary2(j, i) = ary1(i, j)
    Next
  Next
  ws2.Range(ws2.Cells(2, 1), ws2.Cells(UBound(ary2, 1) + 2, 2)) = ary2
  Application.DisplayAlerts = False
  ws.Delete
  Application.DisplayAlerts = True
  Debug.Print Timer - sTimer
End Sub

大量データで処理時間がかかる関数の対処方法(WorksheetFunction)
こちらで解説した考え方に基づいた処理方法です。
キーを並べて、順処理しています。


10.ADO + SQL

'ADO + SQL
Sub sample10()
  Dim objCn As New ADODB.Connection
  Dim objRS As ADODB.Recordset
  Dim strSQL As String
  Dim i As Long
  Dim j As Long
  Dim ix As Long
  ws2.Range("A1").CurrentRegion.Offset(1).Clear
  sTimer = Timer
  With objCn
'    Excel2003まで
'    .Provider = "Microsoft.Jet.OLEDB.4.0"
'    .Properties("Extended Properties") = "Excel 8.0"
'    Excel2007以降
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Properties("Extended Properties") = "Excel 12.0"
    .Open ThisWorkbook.Path & "\" & ThisWorkbook.Name
  End With
  strSQL = ""
  strSQL = strSQL & " SELECT D.キー, SUM(D.データ)"
  strSQL = strSQL & " FROM [" & ws1.Name & "$] AS D"
  strSQL = strSQL & " GROUP BY D.キー"
  Set objRS = New ADODB.Recordset
  Set objRS = objCn.Execute(strSQL)
  ws2.Range("A2").CopyFromRecordset objRS
  objCn.Close
  Set objCn = Nothing
  Debug.Print Timer - sTimer
End Sub

シートをデータベースのテーブルとして扱うものです。
ADODBを使い、SQL文を発行し集計結果を取得しています。
Excel2003までの記述の場合、一定件数を超えると正しく集計されません。
ADOとSQLについては、以下を参照してください。
VBAでのSQLの基礎(SQL:Structured Query Language)
ADOでマスタ付加と集計(SQL)



結果発表

当初掲載した以下の結果において、ADOの計測に間違いがありましたので、修正掲載しています。

1位.Sort + 配列
2位.ピボット + コピペ
3位.Dictionary + 配列

4位.ADO + SQL

データ1
1,000*30
データ2
10,000*3
データ3
10,000*30
データ4
100,000*3
総合
順位 タイム 順位 タイム 順位 タイム 順位 タイム 順位
1 ワークシート関数を使った基本 1 9 4.794 7 41.513
2 ワークシート関数を使った基本 2 10 46.973 10 97.799
3 AdvancedFilter + SumIf 1 8 4.132 9 43.215
4 AdvancedFilter + SUMIF 2 7 4.091 8 42.647
5 ピボット + コピペ 1 0.115 4 0.495 1 0.992 4 6.678 2
6 配列のみで 1 5 2.120 5 21.066
7 配列のみで 2 6 3.224 6 23.802
8 Dictionary + 配列 3 0.276 2 0.286 4 2.853 2 4.863 3
9 Sort + 配列 2 0.125 1 0.135 2 1.017 1 1.788 1
10 ADO + SQL 4 0.281 3 0.361 3 2.188 3 5.452 4

「データ3」「データ4」は、それまでの時間が1秒を切っている、
5.ピボット + コピペ
8.Dictionary + 配列
9.Sort + 配列
10.ADO + SQL
以上だけで行いました。
さすがに、このデータ量になると、他の処理方法では時間がかかりすぎてしまいます。



総評

1.ワークシート関数を使った基本 1
一般的には、十分な速度ではないでしょうか。
特に処理速度にこだわらなければ、数万程度までは、この処理方法で十分でしょう。

2.ワークシート関数を使った基本 2
どうしても、CountIfとMatchの2回行っているので、遅くなるのは仕方ないでしょうか。
On Error Resume Nextを使わないためのVBAコードとしての位置づけでしょうか。
処理速度にこだわらないのなら、とてもきれいな処理方法だと思います。

3.AdvancedFilter + SumIf 1
VBAコードの記述が短くて、AdvancedFilterさえ知っていれば、わかり易い処理方法です。
しかしどうしても、大量データでは、SumIfが遅いです。

4.AdvancedFilter + SUMIF 2
VBAでSumIfを使うか、シートでSUMIFを使うかは、ほとんど好みの問題でしょうか。
ただし、単なる集計ではなく、他の関数と組み合わせて使うような場合は、
WorksheetFunctionより、シート関数を使った方がVBAが書きやすいかもしれません。

5.ピボット + コピペ
やはり、ピボットの集計は速いですね。
特に、集約度合(元データ件数に対するキーの件数)が高いと驚異的な速さです。
ただし、VBAでピボットを扱うのは、結構骨が折れます。
なにより、単純集計以外では、なかなか使うのが難しいです。
データベース形式が崩れているような表(ピボット集計できない表)では使えないという難点もあります。

6.配列のみで 1
数万程度までのデータ量なら、これは融通の利くVBAコードで、
臨機応変に処理を変更できるのが便利です。
しかし、大量データになってくると、配列内の検索に時間がかかってしまいます。

7.配列のみで 2
配列のみで 1とほぼ同じですね。
Filter関数って、便利そうなのですが、意外と使う機会がないものです。

8.Dictionary + 配列
速度としては申し分ないと思います。
ピボットとも遜色ありませんね。
集約度合(元データ件数に対するキーの件数)が高いとピボットに負けるといった感じです。
しかし、Dictionaryには、配列やオブジェクトを格納できるので、
より複雑な集計処理では絶大な威力を発揮します。

9.Sort + 配列
私見としては、これが最速最強です。
複雑な集計でも、臨機応変に対応するVBAコードにすることが出来ます。

10.ADO + SQL
今回は、既に開いているブックでの集計でしたので、他に後れを取った気がします。
他のブックを集計する場合でも、ADOであればあまり変わらない速度で集計できますので、順位がかなり変わってくるはずです。
また、最大値、最小値、平均値等々、SQLに豊富な関数が用意されていますので、
SQL文を自在に書けるなら、かなり複雑な処理も可能です。
ただし、シートのデータが正しくデータベース形式になっている必要があります。

全体として
上位4通りの処理速度は、測定誤差と実用度を考えると大差ないと言ってよいと思います。
データの特質(データ量、集約度)によって使い分けすれば良いでしょう。
VBAで自動化する場合、
仕様が完全に固まっていれば良いのですが、仕様変更が頻繁に発生するものです。
そのような時に、自在に変更しやすいのは、
8.Dictionary + 配列9.Sort + 配列 であろうと思います。
これらのVBAコードであれば、臨機応変に仕様変更に対応できます。
この2つの方法をマスターすれば、どんな大量データでも恐るるに足りず。
10.ADO + SQLについては、これを自在に使えるのなら、何もいう事はありません。
SQLが分からない人は、SQLを勉強してみるのも良いと思います。


本記事はまとめるのに、ずいぶんと時間がかかりました、結構疲れました。
大方としては、予想通りの結果でした。
ただ、VBAでピボットはあまり使わないので、こんなに速かったんだ、と再認識したことと、
ADOは使い方によっては、やはりとても便利だなーと、
そして何より、並べ替えての配列処理のすごさを再認識しました。

VBAの基本的な速度対策については、以下を参照してください。
速度比較決定版【Range,Cells,Do,For,For Each】
エクセルVBAのパフォーマンス・処理速度に関するレポート
マクロVBAの高速化・速度対策の具体的手順と検証
大量データで処理時間がかかる関数の対処方法(WorksheetFunction)




同じテーマ「ExcelマクロVBA技術解説」の記事

遅い文字列結合を最速処理する方法について
配列の使い方について
最終行の判定、Rangeオブジェクトと配列、高速化の為に
記述による処理速度の違い
速度比較決定版【Range,Cells,Do,For,ForEach】
エクセルVBAのパフォーマンス・処理速度に関するレポート
VBAのFindメソッドの使い方には注意が必要です

新着記事 ・・・新着記事一覧を見る

空白セルを正しく判定する方法2|ExcelマクロVBA技術解説(5月6日)
フルパスをディレクトリ、ファイル名、拡張子に分ける|ExcelマクロVBA技術解説(4月15日)
テキストボックスの各種イベント|Excelユーザーフォーム入門(4月9日)
フォルダ(サブフォルダも全て)削除する、Optionでファイルのみ削除|ExcelマクロVBAサンプル集(4月4日)
最後の空白(や指定文字)以降の文字を取り出す|エクセル関数超技(3月26日)
先頭の数値、最後の数値を取り出す|エクセル関数超技(3月26日)
Excelファイルを開かずにシート名をチェック|ExcelマクロVBAサンプル集(3月23日)
数式の参照しているセルを取得する|ExcelマクロVBAサンプル集(3月18日)
CSVの読み込み方法(改の改)|ExcelマクロVBAサンプル集(3月17日)
変数とプロシージャーの命名について|ExcelマクロVBA技術解説(2月12日)

アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|ExcelマクロVBA入門
2.ひらがな⇔カタカナの変換|エクセル基本操作
3.RangeとCellsの使い方|ExcelマクロVBA入門
4.Range以外の指定方法(Cells,Rows,Columns)|ExcelマクロVBA入門
5.徹底解説(VLOOKUP,MATCH,INDEX,OFFSET)|エクセル関数超技
6.変数とデータ型(Dim)|ExcelマクロVBA入門
7.セルの参照範囲を可変にする(OFFSET,COUNTA,MATCH)|エクセル関数超技
8.セルのコピー&値の貼り付け(PasteSpecial)|ExcelマクロVBA入門
9.CSVの読み込み方法|ExcelマクロVBAサンプル集
10.定数と型宣言文字(Const)|ExcelマクロVBA入門



  • >
  • >
  • >
  • 大量データにおける処理方法の速度王決定戦

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。




    ↑ PAGE TOP