エクセルのファイル（ブック）同士を比較するマクロ
エクセルマクロのお勉強
前回は致命的欠陥を持ちつつも、エクセルのシート同士を比較するマクロを苦心して完成させることができました
シート同士比較できるなら、ファイル同士も比較できるのではないかと考え、今回はファイル同士を比較するマクロを作成してみました
※ソースコード全文は記事の最後に
２つのファイル同士を比較するので当然２つのエクセルファイルを選ぶ必要がありますが、これは簡単！
「Application.GetOpenFilename」を使ってユーザに選んでもらいましょう
変数「OrgBookPath」、「RevBookPath」に比較するファイルをそれぞれ格納
皆さんのために、今回だけ特別に「.csv」も比較できるようにしときました！( *´艸｀)
ｶﾝｼｬｼﾀﾏｴ
２つのファイルを選択する上で、一つケアしておきたいのがファイル名です
詳細は省きますが、パスさえ異なれば同じ名前であろうがファイル自体は存在できます
しかし、開こうと思ったら話は別。。。同じファイル名のファイルを同時に開くことはできません
そこで、今回は比較しようとしている２つのファイル名が同じかどうかだけはケアしておくことにします
ファイルの比較処理
ここに、２つのファイルが存在します
A.xlsx と B.xlsx
各ファイルにはそれぞれ「シート」を持っています。持っているハズですぅ
そこでファイル同士を比較する際、比較する２つのファイルの中で同一シート名のものを比較するということで今回はマクロを組んでみました
つまりどゆことかと言いますと
A.xlsxには「Sheet1」、「Sheet2」、「Sheet3」
B.xlsxには「Sheet1」、「Sheet2」、「Sheet3」、「Sheet4」
両ファイルに存在している「Sheet1」、「Sheet2」、「Sheet3」を比較対象として認識するということです
B.xlsxに存在する「Sheet4」は比較対象として認識しません
ここまでコード化できたら、後は簡単
シート同士の比較は前回作成しておりますので、コードは全文流用しちゃいましょう
前述、致命的欠陥を抱えているとお話しましたが、以下の欠陥を抱えております
●ひらがな・カタカナの区別ができません
●大文字・小文字の区別ができません
比較処理としては致命的だな！
それでもよろしければ、ソースコードどうぞ
ヒマがあれば欠陥に対してもなおしていきますぅ～
●以下ソース
Private Sub FileHikaku()
Dim OrgBook As Workbook
Dim RevBook As Workbook
Dim OrgBookPath As String
Dim RevBookPath As String
Dim OrgBookName As String
Dim RevBookName As String
OrgBookPath = Application.GetOpenFilename(filefilter:="Excelブック,*.xls?;*.csv")
RevBookPath = Application.GetOpenFilename(filefilter:="Excelブック,*.xls?;*.csv")
OrgBookName = Mid(OrgBookPath, InStrRev(OrgBookPath, "\") + 1)
RevBookName = Mid(RevBookPath, InStrRev(RevBookPath, "\") + 1)
If OrgBookName = RevBookName Then
MsgBox "Same File Name!"
End Sub
End If
Set OrgBook = Workbooks.Open(OrgBookPath)
Set RevBook = Workbooks.Open(RevBookPath)
Dim RevBook As Workbook
Dim OrgBookPath As String
Dim RevBookPath As String
Dim OrgBookName As String
Dim RevBookName As String
OrgBookPath = Application.GetOpenFilename(filefilter:="Excelブック,*.xls?;*.csv")
RevBookPath = Application.GetOpenFilename(filefilter:="Excelブック,*.xls?;*.csv")
OrgBookName = Mid(OrgBookPath, InStrRev(OrgBookPath, "\") + 1)
RevBookName = Mid(RevBookPath, InStrRev(RevBookPath, "\") + 1)
If OrgBookName = RevBookName Then
MsgBox "Same File Name!"
End Sub
End If
Set OrgBook = Workbooks.Open(OrgBookPath)
Set RevBook = Workbooks.Open(RevBookPath)
Dim OrgSheetName As String
Dim RevSheetName As String
Dim OrgStr As String
Dim RevStr As String
Dim MatchNameBool As Boolean
Dim r As Range
Dim s As Range
Dim OrgRng As Range
Dim RevRng As Range
Dim row As Long, col As Long
For i = 1 To OrgBook.Worksheets.Count
DoEvents
MatchNameBool = False
OrgSheetName = OrgBook.Worksheets(i).Name
For j = 1 To RevBook.Worksheets.Count
DoEvents
If OrgSheetName = RevBook.Worksheets(j).Name Then
MatchNameBool = True
Set OrgRng = OrgBook.Worksheets(i).UsedRange
For Each r In OrgRng
DoEvents
OrgStr = r.Value
If Len(OrgStr) > 0 Then
row = r.row
col = r.Column
Set RevRng = RevBook.Worksheets(j).Cells(row, col)
RevStr = RevRng.Value
If StrComp(OrgStr, RevStr, vbTextCompare) <> 0 Then
RevRng.Interior.Color = RGB(255, 255, 0)
End If
End If
Next r
End If
Next
If MatchNameBool = False Then
OrgBook.Worksheets(i).Tab.ColorIndex = 3
End If
Next
row = 0
col = 0
OrgStr = ""
RevStr = ""
MatchNameBool = False
Set OrgRng = Nothing
Set RevRng = Nothing
For m = 1 To RevBook.Worksheets.Count
DoEvents
MatchNameBool = False
RevSheetName = RevBook.Worksheets(m).Name
For n = 1 To OrgBook.Worksheets.Count
DoEvents
If RevSheetName = OrgBook.Worksheets(n).Name Then
MatchNameBool = True
Set RevRng = RevBook.Worksheets(m).UsedRange
Dim RevSheetName As String
Dim OrgStr As String
Dim RevStr As String
Dim MatchNameBool As Boolean
Dim r As Range
Dim s As Range
Dim OrgRng As Range
Dim RevRng As Range
Dim row As Long, col As Long
For i = 1 To OrgBook.Worksheets.Count
DoEvents
MatchNameBool = False
OrgSheetName = OrgBook.Worksheets(i).Name
For j = 1 To RevBook.Worksheets.Count
DoEvents
If OrgSheetName = RevBook.Worksheets(j).Name Then
MatchNameBool = True
Set OrgRng = OrgBook.Worksheets(i).UsedRange
For Each r In OrgRng
DoEvents
OrgStr = r.Value
If Len(OrgStr) > 0 Then
row = r.row
col = r.Column
Set RevRng = RevBook.Worksheets(j).Cells(row, col)
RevStr = RevRng.Value
If StrComp(OrgStr, RevStr, vbTextCompare) <> 0 Then
RevRng.Interior.Color = RGB(255, 255, 0)
End If
End If
Next r
End If
Next
If MatchNameBool = False Then
OrgBook.Worksheets(i).Tab.ColorIndex = 3
End If
Next
row = 0
col = 0
OrgStr = ""
RevStr = ""
MatchNameBool = False
Set OrgRng = Nothing
Set RevRng = Nothing
For m = 1 To RevBook.Worksheets.Count
DoEvents
MatchNameBool = False
RevSheetName = RevBook.Worksheets(m).Name
For n = 1 To OrgBook.Worksheets.Count
DoEvents
If RevSheetName = OrgBook.Worksheets(n).Name Then
MatchNameBool = True
Set RevRng = RevBook.Worksheets(m).UsedRange
For Each s In RevRng
DoEvents
RevStr = s.Value
If Len(RevStr) > 0 Then
row = s.row
col = s.Column
Set OrgRng = OrgBook.Worksheets(n).Cells(row, col)
OrgStr = OrgRng.Value
If StrComp(RevStr, OrgStr, vbTextCompare) <> 0 Then
OrgRng.Interior.Color = RGB(255, 255, 0)
End If
End If
Next s
End If
Next
If MatchNameBool = False Then
RevBook.Worksheets(m).Tab.ColorIndex = 3
End If
Next
MsgBox "kanryo!"
End Sub
DoEvents
RevStr = s.Value
If Len(RevStr) > 0 Then
row = s.row
col = s.Column
Set OrgRng = OrgBook.Worksheets(n).Cells(row, col)
OrgStr = OrgRng.Value
If StrComp(RevStr, OrgStr, vbTextCompare) <> 0 Then
OrgRng.Interior.Color = RGB(255, 255, 0)
End If
End If
Next s
End If
Next
If MatchNameBool = False Then
RevBook.Worksheets(m).Tab.ColorIndex = 3
End If
Next
MsgBox "kanryo!"
End Sub
