たとえばテストのエビデンスを取得するときも、データをExcelに貼り付けて確認フローに回される。
そのため、Excelファイルを比較することが場面によく出会うだろう。
そこで、VBAで2つのExcelファイルを高速で比較するマクロをつくってみた。
また性能改善のTips、コツもあわせてまとめる。
(SIerを退職してから早1年半、Excelをまったく触らなくなった。また、この記事のメモも2年前に書いたものなので説明が雑になることがありますｗ)
2つのファイルを比較する
Sheet1またはThisWorkbook
' Sheet1
Option Explicit
' 処理時間計測用
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Sub DiffButton_Click()
Dim startTime As Long
startTime = GetTickCount
Result.Text = ""
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error GoTo ErrHandler
'----------------------------------------
' Excelオブジェクトの作成
'----------------------------------------
Dim excel1 As Object
Dim excel2 As Object
Set excel1 = CreateObject("Excel.Application")
Set excel2 = CreateObject("Excel.Application")
excel1.Application.Workbooks.Open Filename:=Target1.Text
excel2.Application.Workbooks.Open Filename:=Target2.Text
'----------------------------------------
' ファイルの比較チェック開始
'----------------------------------------
Dim errorList As New Collection
Set errorList = Diff(excel1, excel2)
'----------------------------------------
' 比較チェックの結果表示
'----------------------------------------
If errorList.Count = 0 Then
Result.Text = "ファイルが一致しました。"
Else
Result.Text = "ファイルが一致しませんでした。"
'-- エラーメッセージの出力
Dim error As Variant
For Each error In errorList
Result.Text = Result.Text & vbCrLf & error
Next
End If
GoTo Finally
ErrHandler:
Result.Text = Err.Number & ":" & Err.Description
Resume Finally
Finally:
'-- 終了処理
excel1.Application.Workbooks.Close
excel2.Application.Workbooks.Close
excel1.Application.Quit
excel2.Application.Quit
Result.Text = Result.Text & vbCrLf & "処理時間：" & (GetTickCount - startTime) / 1000 & "秒"
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'----------------------------------------
' ひとつ目のファイルを選択するボタン
'----------------------------------------
Private Sub RefButton1_Click()
Dim path As Variant
path = FileOpenDialog
If path <> "" Then
Target1.Text = path
End If
End Sub
'----------------------------------------
' ふたつ目のファイルを選択するボタン
'----------------------------------------
Private Sub RefButton2_Click()
Dim path As Variant
path = FileOpenDialog
If path <> "" Then
Target2.Text = path
End If
End SubModule1
' Module1
Option Explicit
'--------------------------------------------------------
' ファイルオープンダイアログ
'--------------------------------------------------------
Function FileOpenDialog() As Variant
Dim fd As Object
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Filters.Add "Excelファイル", "*.xls,*.xlsx"
If .Show = -1 Then
FileOpenDialog = .SelectedItems.Item(1)
Else
FileOpenDialog = ""
End If
End With
End Function' Module1
'--------------------------------------------------------
' Excelファイルの比較
'
' 引数：excel1 比較対象ファイル１のオブジェクト
' excel2 比較対象ファイル２のオブジェクト
' 戻値：エラーリスト（Collection型）
'--------------------------------------------------------
Function Diff(ByRef excel1 As Object, ByRef excel2 As Object) As Collection
'-- 最終行と最終列
Dim lastRow As Long: lastRow = excel1.Sheets(1).UsedRange.Rows.Count
Dim lastCol As Long: lastCol = excel1.Sheets(1).UsedRange.Columns.Count
'-- エラーリスト
Dim errorList As New Collection
'------------------------------------------------
' 列名をチェックし同一ファイルか確認する
'------------------------------------------------
Dim rowIdx As Long
Dim colIdx As Long
For colIdx = 1 To lastCol
If excel1.Sheets(1).Cells(1, colIdx).value <> excel2.Sheets(1).Cells(1, colIdx).value Then
errorList.Add ("ファイルが違います。")
Set Diff = errorList
Exit Function
End If
Next
'------------------------------------------------
' Excelのデータを配列にコピー
' ※ 配列コピーには時間がかかるので列名チェック後に処理する
'------------------------------------------------
Dim excelRange1 As Variant
With excel1.Sheets(1)
excelRange1 = .Range(.Cells(1, 1), .Cells(lastRow, lastCol))
End With
Dim excelRange2 As Variant
With excel2.Sheets(1)
excelRange2 = .Range(.Cells(1, 1), .Cells(lastRow, lastCol))
End With
'------------------------------------------------
' データの内容チェック
'------------------------------------------------
'-- 1行目はラベルなので2行目からスタート
For rowIdx = 2 To lastRow
For colIdx = 1 To lastCol
If excelRange1(rowIdx, colIdx) <> excelRange2(rowIdx, colIdx) Then
'-- エラーメッセージの格納
errorList.Add (PadLeft(rowIdx, 8, " ") & "行目：" & excelRange1(1, colIdx))
End If
Next
Next
'------------------------------------------------
' エラーリストの返却
'------------------------------------------------
Set Diff = errorList
End Function
'--------------------------------------------------------
' パディング処理（右寄せ）
'
' 引数：value パディングする文字列
' totalWidth 結果として生成される文字列の文字数
' paddingChar 埋め込み文字列
' 戻値：totalWidth の長さになるまで左側に paddingChar の文字が埋め込まれた文字列
'--------------------------------------------------------
Function PadLeft(ByVal value As Variant, ByVal totalWidth As Long, ByVal paddingChar As String)
PadLeft = String(totalWidth - Len(value), paddingChar) & value
End Functionワークシートにボタンを3つ用意し、それぞれのクリックイベントに
「DiffButton_Click」「RefButton1_Click」と「RefButton2_Click」を紐付ける。
RefButton_Clickで比較対象となるExcelファイルを選択する。
DiffButton_Clickで比較をはじめる。
DiffButtonをクリックすると、ワークシートに「10行目: Diff text」のような比較結果が表示される。
追記: 2016/08/18 19:30
このままではVBAがコンパイルエラーになってしまうので、
ワークシートにTextBoxオブジェクトを3つ用意し、それぞれに「Target1」「Target2」「Result」という名前をつける。
Target1、Target2は比較対象のファイルパスを入力するために、Resultは比較結果を出力するために利用する。
問い合わせフォームよりご指摘いただいて気付きました。
ありがとうございました！
性能向上のための工夫
今回紹介したVBAには性能向上のため、いくつかの工夫をしている。
- ループするときは配列にコピーしてから行う
- セルのコピーはRangeで一気に行う
- データ入力、チェック、出力など処理を分ける
- Integer型ではなくLong型を使う
- 可変配列はReDimではなくCollectionを使う
- 引数のサイズが大きい場合はByRefを使う
- セルの参照はCells.Value（またはCells）を使う
1. ループするときは配列にコピーしてから行う
2. セルのコピーはRangeで一気に行う
セルをひとつずつ参照するのは非常に非効率だからだ。そのため、Rangeでワークシートを2次元配列にコピーする。
1. と 2. で一旦メモリ上の配列にコピーしてしまえば、ループだって比較だって高速で処理することができる。
3. データ入力、チェック、出力など処理を分ける
たとえばデータを読み込みながらチェックをしないとか、チェックをしながらデータを出力（書き込み）しないとか。
データ入力は入力だけ、チェックはチェックだけ、出力は出力だけと処理を分けたほうが性能が良くなる。
ただ、メモリを爆食いしてしまうので注意が必要だ。
4. Integer型ではなくLong型を使う
Long型よりInteger型のほうが利用メモリも少なく良いように思われる。
Integer型は16bit、Long型は32bitだ。
今のOSはほとんどが32bit、64bitなので、bitの変換が不要、または少ないLong型の方が性能が良くなる。
5. 可変配列はReDimではなくCollectionを使う
入門書の配列の章では「ReDimして配列を拡張する」みたいなことが説明されている。
しかし毎回ReDimをするとメモリ上で再配置が行われ、性能が落ちてしまう。
そんなときはCollectionを使用すると良い。
使い勝手も普通の配列よりダンゼンCollectionの方が扱いやすい。
6. 引数のサイズが大きい場合はByRefを使う
VBAでは参照渡し（ByRef）か値渡し（ByVal）が指定できる。
ふだん使う分には値渡しのByValの方が便利だ。
しかし、Object型などサイズが大きい変数を渡すときは、ByRefを使うことでメモリを余分に使わなくてすむ。
ただし参照渡しは渡し元と渡し先のプロシージャで同じアドレスを見ているため、内容が書き換わってしまう可能性があることだけは理解して使ってほしい。
7. セルの参照はCells.Value（またはCells）を使う
実はCells.Textで参照すると性能がガタッと落ちてしまう。
そのため、Cells.Valueを使う。（今回のVBAではCellsのみを使っている）
以下の記事で、実際に性能を計った結果をまとめているので参考にしていただきたい。
これらの性能改善のコツは簡単に実施できるものばかりなので、ぜひ自分のVBAにも適用し、性能の違いを体感してほしい。
以上
written by @bc_rikko
0 件のコメント :
コメントを投稿