読者です 読者をやめる 読者になる 読者になる

データ比較用エクセルマクロ(バージョン2)

概要

改修前の調査やテスト時にDBの情報がどう変化したのか見たい事があります。処理の前と後でテーブルのデータをExcelに貼り付けて変化したセルを探したりするのですが、データ数が多いと目視では見つけられなくなります。式で「=[セルA]=[セルB]」と書いてtrue,falseを表示して判定していたのですが、いちいち書いているのも大変になってきたのでマクロを書いてみました。
(以前(2010/10/11)に公開していたコードの改良版です)

使い方

1.エクセルでVisual Basicのエディタを立ち上げて、標準モジュールを追加し、下記のマクロ貼り付けてください。
2.セル範囲を2箇所選択します。選択する行数はそろえてください。列は適当でよいです。選択範囲にかかわらず、A列から最終列まで自動的に比較対象となります。

3.マクロ diffTwoRangesSelectAll か diffTwoRangesSelectAllを実行して下さい。
値が違うセルが選択されて処理が終了します。背景色を手動で変えて終わりです。

マクロ

Public Sub diffTwoRangesSelectAll()
    diffTwoRanges True
End Sub

Public Sub diffTwoRangesSelectAfter()
    diffTwoRanges False
End Sub

Private Sub diffTwoRanges(selectAll As Boolean)
    
    If (Selection.Areas.Count <> 2) Then
        MsgBox "2箇所を選択してください"
        End
    End If
    
    If (Selection.Areas(1).Rows.Count <> Selection.Areas(2).Rows.Count) Then
        MsgBox "選択範囲の行数はそろえてください"
        End
    End If
    
    
    Dim currentCol As Integer
    Dim currentRow As Integer
    
    Dim area1StartRow As Integer
    Dim area2StartRow As Integer
    
    Dim area1Cell As Range
    Dim area2Cell As Range
    
    area1StartRow = Selection.Areas(1).Cells(1).Row
    area2StartRow = Selection.Areas(2).Cells(1).Row
    
    Dim sheet As Worksheet
    Set sheet = ActiveSheet
    
    Dim result As Range
    
    
    Set result = Nothing
    
    
    For currentRow = 1 To Selection.Areas(1).Rows.Count
        For currentCol = 1 To 256
            Set area1Cell = sheet.Cells(area1StartRow + currentRow - 1, currentCol)
            Set area2Cell = sheet.Cells(area2StartRow + currentRow - 1, currentCol)
            
            If (area1Cell.Text <> area2Cell.Text) Then
                If (result Is Nothing) Then
                    Set result = area2Cell
                Else
                    Set result = Union(result, area2Cell)
                End If
 
                If (selectAll) Then
                    Set result = Union(result, area1Cell)
                End If
               
            End If
            
        Next
    Next

    If (result Is Nothing) Then
        MsgBox "違いは見つかりませんでした。"
    Else
        result.Select
    End If
    
End Sub