Excelファイル簡易比較VBA

感想おまちしてます!

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