1記事1ツールをVBAで作るサンプルシリーズ2です。
前回のツール作成サンプルで作成したツールを高速化しました。
前回のサンプルシリーズは「ツール作成サンプル 売上を自動集計する」をご覧ください。
上記のツールでも十分使用できますが、もしデータが10万行やそれ以上となった場合には、どうしてもSumif関数や、セルへの出力を都度行っていると処理速度が遅くなってしまいます。
そこで、今回は同じサンプルツールを高速化してみたいと思います。
また、両方のツールの処理速度比較も行いたいと思います。
前回よりは難しくなりますが、少しでもイメージしやすい内容で作成します。
前回のツールの方法では「Application.ScreenUpdating = False」で描画止めても、集計部分の計測で「約27.60秒」でした。
今回のツールでは「約3.24秒」でした。(PCスペックで処理速度は変わります。)
1.ツールを作る上で大事なこと
ツールを作るには、ある程度ツールの設計を考える必要があります。
簡単なツールであれば設計を飛ばして作成しても問題ありませんが、複雑なツールになるほど設計は大事になります。
そして、ツールは1つ1つのパーツを作り、組み立てていくことで出来上がります。
また、ツール作成に慣れている場合を除いて、複雑なコードをいきなり書き始めるのではなく静的なちゃんと動くコードを書いてから、汎用性や処理速度の高いコードにしていくことをお勧めします。
2.今回使うサンプルデータ
今回は次のような注文日、注文番号、商品、単価、販売数量、売上金額の1か月分のデータ10万行を使用します。
商品の種類も5種類から100種類へ増やしました。(データ個数100001です)
3.ツールの最終アウトプットと設計(プロセス)を考える
今回も前回同様に「決まった形のファイルを読み込んで、集計をして、別ファイルに集計結果を出力する」というツールを作成します。
いきなり完成系のツールを作り始めるのではなく、まずは最終的にどのようなアウトプットを目標としているかを考えます。
そして、そのアウトプットを実現するための設計(プロセス)を考えたいと思います。
最終的なアウトプット
今回は「日別」、「商品別」の2種類の売上集計をしたいと思います。
売上と一緒に「販売数量」も一緒に集計したいと思います。
前回は日単位でしたが、10万行分データを作成したため、月単位に圧縮してみました。
全体の設計
大まかで構いませんので全体設計を考えます。
前回と同じですが、最初はこれくらいシンプルでも構いません。
全体設計の各パーツをもう少し具体的に考えてみる
ここから各パーツについてもう少し具体的に考えていきます。
今回はある程度プロセスを絞り込んで話を進めたいと思います。
ファイルを読み込む
ファイルはダイアログボックスを開いて、ユーザーに指定してもらう方法で作成します。
集計する
ここが前回と大きく変わる部分になります。
配列を使ったり、Sumif関数を使わない方法で高速化したいと思います。
プロセスイメージは次の通りです。
別ファイルに出力する
読み込み→集計の次は別ファイルに出力するパーツです。
「ユーザーに保存場所もファイル名も指定してもらう」方法を使用します。
4.コードを書く
最終的なアウトプットと設計(プロセス)が出来たので、次は各パーツのコードを書いていきます。
ファイルを読み込むコード
次のコードはダイアログを開いて、選択されたファイルを読み込みます。
ユーザーに選択させるリスクとして間違ったファイルを選択する可能性もありますので、念のため項目が形式と一致しているかの判定をしています。
ダイアログを開く方法は「ダイアログで指定したファイルを読み込む」をご覧下さい。
Sub Sample1()
Dim FilePass As Variant
Dim FileName As String
Dim ShCount As Long
ShCount = ThisWorkbook.Worksheets.Count 'VBAの書かれたファイルのシート数
'ダイアログを開いてファイルを指定
FilePass = Application.GetOpenFilename("Excelブック,*.xlsx,Excelマクロ,*.xlsm,テキスト,*.txt")
If FilePass <> "False" Then
FileName = Dir(FilePass) 'ファイル名を取得
Workbooks.Open FilePass 'ファイルを開く
Worksheets(1).Copy after:=ThisWorkbook.Worksheets(ShCount) '一番最後に追加
Workbooks(FileName).Close savechanges:=False
ActiveSheet.Name = "データ" '読み込んだシート名を変更する
'データをチェックする
With ActiveSheet
'項目が注文日/注文番号/商品/単価/販売数量/売上金額であることが条件
If Not (.Cells(1, 1) = "注文日" And _
.Cells(1, 2) = "注文番号" And _
.Cells(1, 3) = "商品" And _
.Cells(1, 4) = "単価" And _
.Cells(1, 5) = "販売数量" And _
.Cells(1, 6) = "売上金額") Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
MsgBox "集計できないデータ形式です。"
End
End If
End With
Else
End
End If
End Sub集計するコード
次のコードは読み込んだデータを集計します。
前回の日付を日単位から月単位にまとめていますが、コード内の「“yyyy/mm”」の部分を「“yyyy/mm/dd”」もしくは「“yyyy/m/d”」とすることで日単位に集計できます。
集計や装飾部分を1プロシージャにまとめて、上から順にプロセス通りに書いています。
流れとしてはアウトプット用のリストをDictionaryで生成しつつ、販売数量と売上を同時に集計します。
集計後項目を入力して、Dictionaryに格納した集計結果を配列に出力しています。
最後に一括で配列を出力してから、表を装飾しています。
リスト作成のDictionaryについては「Dictionaryの使い方」をご覧ください。
配列は「配列の使い方(基礎編)」、「配列の使い方(応用編)」をご覧ください。
より複雑なコードの場合は計算部分など、さらに「ユーザー定義関数(Functionプロシージャ)」で分割すると、複雑なツールを作る際に可読性が上がります。
Sub Sample2()
Dim MaxRow As Long
Dim i As Long
Dim ImpWS As Worksheet
Dim OutWS As Worksheet
Dim DateDic1 As Object
Dim DateDic2 As Object
Dim ItemDic1 As Object
Dim ItemDic2 As Object
Dim myVal As Variant
Dim DateKey As Variant
Dim ItemKey As Variant
Const title1 As String = "日別売上"
Const title2 As String = "商品別売上"
Application.ScreenUpdating = False
Set DateDic1 = CreateObject("Scripting.Dictionary") 'Dictionaryをセット
Set DateDic2 = CreateObject("Scripting.Dictionary") 'Dictionaryをセット
Set ItemDic1 = CreateObject("Scripting.Dictionary") '販売数量Dictionaryをセット
Set ItemDic2 = CreateObject("Scripting.Dictionary") '売上Dictionaryをセット
Set ImpWS = Worksheets("データ")
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "集計結果"
Set OutWS = Worksheets("集計結果")
With ImpWS
MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row
'■■日付のリストと販売数量と売上集計■■
For i = 2 To MaxRow
'表示形式を"yyyy/mm/dd"とすることで日単位で集計できます。
myVal = Format(.Cells(i, 1), "yyyy/mm")
If Not DateDic1.exists(myVal) Then
DateDic1.Add myVal, .Cells(i, 5) '販売数量
DateDic2.Add myVal, .Cells(i, 6) '売上
Else
DateDic1(myVal) = DateDic1(myVal) + .Cells(i, 5) '販売数量
DateDic2(myVal) = DateDic2(myVal) + .Cells(i, 6) '売上
End If
Next i
DateKey = DateDic1.keys
'■■商品のリストと販売数量と売上集計■■
For i = 2 To MaxRow
myVal = .Cells(i, 3)
If Not ItemDic1.exists(myVal) Then
ItemDic1.Add myVal, .Cells(i, 5) '販売数量
ItemDic2.Add myVal, .Cells(i, 5) '売上
Else
ItemDic1(myVal) = ItemDic1(myVal) + .Cells(i, 5) '販売数量
ItemDic2(myVal) = ItemDic2(myVal) + .Cells(i, 6) '売上
End If
Next i
ItemKey = ItemDic1.keys
End With
With OutWS
'■■アウトプット作成■■
.Cells(2, 2) = title1
.Cells(3, 2) = ImpWS.Cells(1, 1)
.Cells(3, 3) = ImpWS.Cells(1, 5)
.Cells(3, 4) = ImpWS.Cells(1, 6)
.Cells(2, 6) = title2
.Cells(3, 6) = ImpWS.Cells(1, 3)
.Cells(3, 7) = ImpWS.Cells(1, 5)
.Cells(3, 8) = ImpWS.Cells(1, 6)
'■■アウトプット用配列に格納後出力■■
ReDim myArray(0 To UBound(DateKey), 0 To 2)
For i = 0 To UBound(DateKey)
myArray(i, 0) = DateKey(i)
myArray(i, 1) = DateDic1(DateKey(i))
myArray(i, 2) = DateDic2(DateKey(i))
Next i
Range(.Cells(4, 2), .Cells(UBound(DateKey) + 4, 4)) = myArray
.Cells(i + 4, 2) = "総計"
'■■アウトプット用配列に格納後出力■■
ReDim myArray(0 To UBound(ItemKey), 0 To 2)
For i = 0 To UBound(ItemKey)
myArray(i, 0) = ItemKey(i)
myArray(i, 1) = ItemDic1(ItemKey(i))
myArray(i, 2) = ItemDic2(ItemKey(i))
Next i
Range(.Cells(4, 6), .Cells(UBound(ItemKey) + 4, 8)) = myArray
.Cells(i + 4, 6) = "総計"
'■■合計集計する■■
MaxRow = .Cells(Rows.Count, 2).End(xlUp).Row
.Cells(MaxRow, 3) = Application.WorksheetFunction.Sum(Range(.Cells(4, 3), .Cells(MaxRow - 1, 3)))
.Cells(MaxRow, 4) = Application.WorksheetFunction.Sum(Range(.Cells(4, 4), .Cells(MaxRow - 1, 4)))
'■■装飾する■■
Range(.Cells(4, 2), .Cells(MaxRow, 2)).NumberFormatLocal = "yyyy/mm" '日付を月単位に指定
Range(.Cells(3, 2), .Cells(MaxRow, 4)).Borders.LineStyle = xlContinuous '罫線
Range(.Cells(3, 2), .Cells(3, 4)).Interior.Color = RGB(64, 64, 64) '背景色
Range(.Cells(3, 2), .Cells(3, 4)).Font.Color = RGB(255, 255, 255) '文字色
Range(.Cells(3, 2), .Cells(3, 4)).HorizontalAlignment = xlCenter '中央揃え
'■■合計集計する■■
MaxRow = .Cells(Rows.Count, 6).End(xlUp).Row
.Cells(MaxRow, 7) = Application.WorksheetFunction.Sum(Range(.Cells(4, 7), .Cells(MaxRow - 1, 7)))
.Cells(MaxRow, 8) = Application.WorksheetFunction.Sum(Range(.Cells(4, 8), .Cells(MaxRow - 1, 8)))
'■■装飾する■■
Range(.Cells(3, 6), .Cells(MaxRow, 8)).Borders.LineStyle = xlContinuous '罫線
Range(.Cells(3, 6), .Cells(3, 8)).Interior.Color = RGB(64, 64, 64) '背景色
Range(.Cells(3, 6), .Cells(3, 8)).Font.Color = RGB(255, 255, 255) '文字色
Range(.Cells(3, 6), .Cells(3, 8)).HorizontalAlignment = xlCenter '中央揃え
.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub集計結果を別ファイルに出力するコード
集計結果が出来たら、ダイアログを開いてファイル名を指定してもらうと、別ファイルとして保存されます。
予めダイアログに「集計結果」というファイル名を入力しています。
Sub Sample3()
Dim ImpWS As Worksheet
Dim OutWS As Worksheet
Dim FileName As String
Set ImpWS = Worksheets("データ")
Set OutWS = Worksheets("集計結果")
OutWS.Move
FileName = Application.GetSaveAsFilename("集計結果", _
"Excel2013,*.xlsx,Excel2003,*.xls,Excel.csv,*.csv", , "Excelブックを保存")
If StrConv(FileName, vbUpperCase) <> "FALSE" Then
On Error Resume Next
ActiveWorkbook.SaveAs FileName:=FileName
ActiveWorkbook.Close
End If
ThisWorkbook.Activate
Application.DisplayAlerts = False
ImpWS.Delete
Application.DisplayAlerts = True
End Subマクロを呼び出すボタンを作成
VBEからコードを呼び出すのは不便なので、オートシェイプで図を挿入し、マクロの登録をすることでボタンを押すと上記で作成したコードが呼び出されるようにしました。
Sub MAIN_Click()
Call Sample1
Call Sample2
Call Sample3
End Sub5.サンプルファイルダウンロード
今回使用したツールのファイルと読み込む用に作成したサンプルファイルをこちらからダウンロードできます。
