2016/07/13

【VBA】2つのExcelファイルを高速で比較する+性能改善のコツ

SIerはなんでもExcelで管理したがる。データベースの中身やコード管理など…。
たとえばテストのエビデンスを取得するときも、データをExcelに貼り付けて確認フローに回される。
そのため、Excelファイルを比較することが場面によく出会うだろう。

そこで、VBAで2つのExcelファイルを高速で比較するマクロをつくってみた。
また性能改善のTips、コツもあわせてまとめる。

(SIerを退職してから早1年半、Excelをまったく触らなくなった。また、この記事のメモも2年前に書いたものなので説明が雑になることがありますw)

2つのファイルを比較する


Sheet1またはThisWorkbook

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 Sub


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


'--------------------------------------------------------
' Excelファイルの比較
'
'   引数:excel1  比較対象ファイル1のオブジェクト
'         excel2  比較対象ファイル2のオブジェクト
'   戻値:エラーリスト(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」という名前をつける。

Target1Target2は比較対象のファイルパスを入力するために、Resultは比較結果を出力するために利用する。

問い合わせフォームよりご指摘いただいて気付きました。
ありがとうございました!



性能向上のための工夫


今回紹介したVBAには性能向上のため、いくつかの工夫をしている。

  1. ループするときは配列にコピーしてから行う
  2. セルのコピーはRangeで一気に行う
  3. データ入力、チェック、出力など処理を分ける
  4. Integer型ではなくLong型を使う
  5. 可変配列はReDimではなくCollectionを使う
  6. 引数のサイズが大きい場合はByRefを使う
  7. セルの参照は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 件のコメント :

コメントを投稿