VBA100本ノック 23本目：シート構成の一致確認

この記事から得るもの

２つのWorkBookのSheet構成（シート名が一致しているかどうか）が同じかどうか判定する。

目次
　１　今回のお題
　２　今回のお題の意図
　３　回答
　４　感想　
　５　追記　Dictionaryで処理　

１　今回のお題

ThisWorkbookと同一フォルダに"Book_20201101.xlsx"と"Book_20201102.xlsx"の2ファイルがあります。
シート構成（シート名のみ、位置は不問）が一致しているか確認してください。
「一致」または「不一致」の結果をメッセージボックスで表示。
※不一致の詳細は不要。

２　今回のお題の意図

2つのBookのSheet名をループして比較させる。

３　回答

ThisWorkbookと同一フォルダとありましたが、自分の都合でThisworkbookに別フォルダ（２３本目）を作成しています。
処理方法としては、Bookを開いて、２つのSheetsを２重ループで比較するというものです。

私の最初の回答

Sub ノック23本目_1()

Dim mypath As String: mypath = ThisWorkbook.Path & "\" & "23本目" & "\"
Dim TargetBookName1, TargetBookName2 As String
TargetBookName1 = "Book_20201101.xlsx": TargetBookName2 = "Book_20201102.xlsx"

Workbooks.Open mypath & TargetBookName1: Workbooks.Open mypath & TargetBookName2

Set TargetBook1 = Workbooks(TargetBookName1): Set TargetBook2 = Workbooks(TargetBookName2)


'Sheet数が異なる場合は、処理終了
If TargetBook1.Sheets.Count <> TargetBook2.Sheets.Count Then
    MsgBox "Sheet構成が異なります。": Exit Sub
End If

'
Sheet2_IX = 0

For Each sheetName1 In TargetBook1.Sheets
    For Each sheetName2 In TargetBook2.Sheets
        Sheet2_IX = Sheet2_IX + 1
        If sheetName1.Name = sheetName2.Name Then
        
        Else
            If TargetBook2.Sheets.Count = Sheet2_IX Then
                MsgBox "Sheet構成が異なります。": Exit Sub
            End If
        End If
    Next
Next

End Sub

よし、これでSheet構成が異なるBookを発見できると思ったら、お題に「一致」または「不一致」の結果をメッセージボックスで表示」とあります。つまり、上のコードでは一致しているかのメッセージボックスが出てきません。
その点ふまえて改良版です。

私の最終回答

Sub ノック23本目_2()

'環境設定
Dim mypath As String: mypath = ThisWorkbook.Path & "\" & "23本目" & "\"
Dim TargetBookName1, TargetBookName2 As String: TargetBookName1 = "Book_20201101.xlsx": TargetBookName2 = "Book_20201102.xlsx"

'Bookを開く
Workbooks.Open mypath & TargetBookName1: Workbooks.Open mypath & TargetBookName2
Dim TargetBook1, TargetBook2 As Workbook: Set TargetBook1 = Workbooks(TargetBookName1): Set TargetBook2 = Workbooks(TargetBookName2)

'Sheet数が異なる場合は、処理終了
If TargetBook1.Sheets.Count <> TargetBook2.Sheets.Count Then
MsgBox "Sheet構成が異なります。"
TargetBook1.Close: TargetBook2.Close: Exit Sub  'Bookを閉じる
End If

'Sheet構成判定処理
Sheet2_IX = 0

For Each sheetName1 In TargetBook1.Sheets
    For Each sheetName2 In TargetBook2.Sheets
        Sheet2_IX = Sheet2_IX + 1
        If sheetName1.Name = sheetName2.Name Then
            Exit For
        Else
            If TargetBook2.Sheets.Count = Sheet2_IX Then
                MsgBox "Sheet構成が異なります。"
                TargetBook1.Close: TargetBook2.Close    'Bookを閉じる
                Exit Sub
            End If
        End If
    Next
    
    If TargetBook2.Sheets.Count = Sheet2_IX Then
        MsgBox "Sheet構成は一致しています。"
        TargetBook1.Close: TargetBook2.Close    'Bookを閉じる
        Exit Sub
    End If
    Sheet2_IX = 0 '初期化
Next

End Sub

ポイントは、変数Sheet2_IX で、Book2のSheet数が最終となっているか判断しています。SheetCountとSheet2_IX が一致していて、シート名が一致していれば「一致している」ということになります。

４　感想

Dictionaryを使って比較する方法があるようです。今のところDictionaryとCollectionでは、Collection派です。しかしDictionaryには存在するかどうかを判定するExistsというものが便利そうなので使い方をマスターしようと思います。とりあえず、書いて練習しよ。

５　追記　Dictionaryで処理

Dictionaryでの処理方法が気になって調べた結果、以下の回答が分かりやすいので追記します。

Dictionaryを使った回答

Sub ノック23_Dictionary()

Dim wb1 As Workbook: Dim wb2 As Workbook

'開いたファイルを設定する
Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\23本目\" & "Book_20201101.xlsx")
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\23本目\" & "Book_20201102.xlsx")

Dim DicSheetName1, DicSheetName2 As Object
Set DicSheetName1 = GetDicSheetNames(wb1)
Set DicSheetName2 = GetDicSheetNames(wb2)

wb1.Close: wb2.Close    '閉じる

'比較処理
For Each cmpSheetName In DicSheetName1
    If Not DicSheetName2.exists(cmpSheetName) Then GoTo Unmatch
Next

MsgBox "一致"

Exit Sub

Unmatch:
    MsgBox "不一致"

End Sub

サブルーチン

Private Function GetDicSheetNames(ByRefwb As Workbook) As Object

Dim dic As Object: Set dic = CreateObject("scripting.Dictionary")
Dim i As Long

For i = 1 To wb.Worksheets.Count
    dic.Add wb.Worksheets(i).Name, i
Next

Set GetDicSheetNames = dic

End Function

Bookを開いて、GetDicSheetNamesでSheet名を取得して閉じてから比較処理をする。Bookを開いてすぐ閉じるという点に、ユーザーへの心遣いを感じます（この程度の処理では時間はかかりませんがｗ）。ExistsでSheet２のファイル名にSheet１のファイル名が無い場合、Unmatch処理に飛んで終了となります。一致していれば、Exit subで終了。
この書き方勉強になりました。

ではでは、このへんで(^^)/~~~

この記事から得るもの

１ 今回のお題

２ 今回のお題の意図

３ 回答