Excelファイル簡易比較VBA

Tweet

2ファイルを比較し、変更のあったセルの色を変更する。比較元となるファイルには何も行わない。

ソース（一部抜粋）

Sub エクセルファイル比較実行()

  処理続行確認メッセージ

  初期設定

  Application.DisplayAlerts = False

  Dim ConfRowNum  ConfRowNum = ActiveSheet.Cells.SpecialCells(xlLastCell).Row  Dim RowNum

  For RowNum = 2 To ConfRowNum

    設定取得 (RowNum)

    Dim FileName1    Dim FileName2    Dim SheetCount1    Dim SheetCount2

    Workbooks.Open Filename:=FilePath1    FileName1 = ActiveWorkbook.Name    Workbooks.Open Filename:=FilePath2    FileName2 = ActiveWorkbook.Name

    SheetCount1 = Workbooks(FileName1).Worksheets.Count    SheetCount2 = Workbooks(FileName2).Worksheets.Count

    Dim SheetNum    SheetNum = 1

    Do While SheetNum <= SheetCount1 And SheetNum <= SheetCount2

      Dim MaxRow      Dim MaxCol      Dim Row      Dim Col      Dim Value1      Dim Value2

      MaxRow = Workbooks(FileName1).Worksheets(SheetNum).Cells.SpecialCells(xlLastCell).Row      MaxCol = Workbooks(FileName1).Worksheets(SheetNum).Cells.SpecialCells(xlLastCell).Column

      '比較ループ      For Row = 1 To MaxRow

        For Col = 1 To MaxCol          Value1 = Workbooks(FileName1).Worksheets(SheetNum).Cells(Row, Col).Value          Value2 = Workbooks(FileName2).Worksheets(SheetNum).Cells(Row, Col).Value

          If Value1 <> Value2 Then            Workbooks(FileName2).Worksheets(SheetNum).Cells(Row, Col).Select            差分有セル色変更          End If        Next

      Next

      SheetNum = SheetNum + 1

    Loop

    Workbooks(FileName2).Save    Workbooks(FileName1).Close    Workbooks(FileName2).Close

  Next

  Application.DisplayAlerts = True

  MsgBox "おわったよー"

End Sub

Tweet