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

公開日：2020-11-12　最終更新日：2021-03-18

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

2つのブックのシート構成が一致しているかを確認する問題です。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータはご自身でご用意ください。

出題

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

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

シートの一致は、まずはシート数を比較したほうが良いでしょう。
ループ比較のみでやろうとすると、両方からのループ確認が必要になってしまいます。
シート存在チェックはエラー処理で簡単に済ませることができます。
細かいことは気にせず、とりあえず比較出来れば良いという事にしてみました。


  
    
      Sub VBA100_23_01()

　　Application.ScreenUpdating = False

　　On Error Resume Next

　　

　　Dim sPath As String: sPath = ThisWorkbook.Path & "\"

　　Dim wb1 As Workbook, wb2 As Workbook

　　Set wb1 = Workbooks.Open(sPath & "\Book_20201101.xlsx", ReadOnly:=True)

　　Set wb2 = Workbooks.Open(sPath & "\Book_20201102.xlsx", ReadOnly:=True)

　　

　　Dim isMismatch As Boolean, sht As Object, tmp As String

　　If wb1.Sheets.Count <> wb2.Sheets.Count Then

　　　　isMismatch = True

　　Else

　　　　For Each sht In wb1.Sheets

　　　　　　'シート無ければエラー

      　　　　　　tmp = wb2.Sheets(sht.Name).Name

　　　　　　If Err Then

　　　　　　　　isMismatch = True

　　　　　　　　Exit For

　　　　　　End If

　　　　Next

　　End If

　　wb1.Close SaveChanges:=False

　　wb2.Close SaveChanges:=False

　　Application.ScreenUpdating = True

　　

　　If isMismatch Then

　　　　MsgBox "不一致"

　　Else

　　　　MsgBox "一致"

　　End If

End Sub

※ツイートの画像では、太字部分の.Nameが抜けていました。

シート名の比較方法として、Dictionaryにいれて比較するのは良い方法だと思います。
また、相手ブックのシートをループして探す方法でも良いと思います。
ブックが開けない場合やグラフシートの考慮等も考えられます。
これらについては記事補足に掲載しました。

補足

上記のVBAでは、エラーになる事を利用した方法になっています。
シート名の大文字小文字は区別されないので、そのあたりは気になるところです。
出来ればエラー処理は避けて、別の方法にしたいところだと思います。

回答でも、Dictionaryを使ったものが目立ちましたが、
片方のシート名をDictionaryに入れて判定するのは良い方法だと思います。

また、ファイルが存在しない場合も含めて、ブックを開くことが出来ない場合もありえます。
何らかの対応をしておくに越したことはないでしょう。
さらに、ワークシートとグラフシートの違いもあるかもしれません。

このあたりを組み込んで、先のVBAとは大分雰囲気を変えたVBAにしてみました。


  
    
      Sub VBA100_23_02()

　　If Workbooks.Count > 1 Then

　　　　MsgBox "他のブックを閉じから実行してください。"

　　　　Exit Sub

　　End If

　　

　　Application.ScreenUpdating = False

　　On Error Resume Next

　　Dim sPath As String: sPath = ThisWorkbook.Path & "\"

　　Dim wb1 As Workbook, wb2 As Workbook

　　Set wb1 = Workbooks.Open(sPath & "\Book_20201101.xlsx", ReadOnly:=True)

　　Set wb2 = Workbooks.Open(sPath & "\Book_20201102.xlsx", ReadOnly:=True)

　　If Err Then

　　　　Call CloseBooks(wb1, wb2)

　　　　MsgBox "ブックが開けない・・・"

　　　　Exit Sub

　　End If

　　

　　Dim isMismatch As Boolean

　　isMismatch = CompareBooks(wb1, wb2)

　　Call CloseBooks(wb1, wb2)

　　

　　Application.ScreenUpdating = True

　　If isMismatch Then

　　　　MsgBox "一致"

　　Else

　　　　MsgBox "不一致"

　　End If

End Sub


Function CompareBooks(ByVal wb1 As Workbook, ByVal wb2 As Workbook) As Boolean

　　CompareBooks = False

　　

　　If wb1.Sheets.Count <> wb2.Sheets.Count Then

　　　　Exit Function

　　End If

　　

　　Dim dic As Object, sht As Object

　　Set dic = CreateObject("Scripting.Dictionary")

　　For Each sht In wb2.Sheets

　　　　dic(sht.Name & vbTab & sht.Type) = ""

　　Next

　　For Each sht In wb1.Sheets

　　　　If Not dic.exists(sht.Name & vbTab & sht.Type) Then

　　　　　　Exit Function

　　　　End If

　　Next

　　

　　CompareBooks = True

End Function


Sub CloseBooks(ParamArray ary())

　　On Error Resume Next

　　Dim i As Long

　　For i = LBound(ary) To UBound(ary)

　　　　ary(i).Close SaveChanges:=False

　　Next

End Sub

その他の方法として、シートをループさせて指定の名称が存在するかの判定でも良いと思います。
シート数は限られるので、処理速度はあまり気にしなくても良いと思います。


  
    
      Function SheetExists(ByVal wb As Workbook, ByVal aName As String) As Boolean

　　Dim ws As Worksheet

　　SheetExists = True

　　For Each ws In wb.Sheets

　　　　If ws.Name = aName Then

　　　　　　Exit Function

　　　　End If

　　Next

　　SheetExists = False

End Function

サイト内関連ページ

第52回．オブジェクト変数とSetステートメント

・オブジェクト変数・個有のオブジェクト型とは・Setステートメント・Setステートメントの使用例・WithとSetの使い分け方・Setステートメントの実践的な使い方・Is演算子によるオブジェクトの比較・最後に

第53回．Workbookオブジェクト

・WorkBookの指定方法・WorkBookのデータ型・WorkBookのプロパティとメソッド・Workbookオブジェクトの使用例・プロパティとメソッドの違い

第55回．Worksheetオブジェクト

・WorkSheetオブジェクトの指定方法・Worksheetオブジェクトデータ型・WorkSheetのプロパティとメソッド・Worksheetオブジェクトの使用方法・Activesheet、Sheetsコレクションについて

第58回．コレクションとは（Collection）

・コレクションの中から単一オブジェクトを指定する場合・セルであるRangeオブジェクトのコレクションは？・コレクションの要素数・Collectionオブジェクト

第59回．コレクション処理（For Each）

・For Each の構文・Exit For ・For Each の使用例・RangeオブジェクトのFor Each ・For Each サイト内の参考ページ

第60回．エラー処理（On Error）

・マクロVBAのエラー発生例・エラー処理のステートメント・実行時エラー関連記事

第61回．「On Error GoTo」と「Exit Sub」

・On Error GoTo 行ラベル・Exit Sub ・On Error の有効範囲とその動作について・最後に

第62回．「On Error Resume Next」とErrオブジェクト

・On Error Resume Next ・Errオブジェクト・On Error Resume Next の使用例・「On Error Resume Next」の最後に

第133回．引数の数を可変にできるパラメーター配列（ParamArray）

・引数の構文・名前付き引数について・ParamArrayキーワード（パラメーター配列）とは・ParamArrayキーワード（パラメーター配列）の使用例・サイト内の関連ページ

同じテーマ「VBA100本ノック」の記事

20本目：ブックのバックアップ
 21本目：バックアップファイルの削除
 22本目：FizzBuzz発展問題
23本目：シート構成の一致確認
24本目：全角英数のみ半角
 25本目：マトリックス表をDB形式に変換
 26本目：ファイル一覧作成
 27本目：ハイパーリンクのURL
28本目：シートをブックに分割
 29本目：画像の挿入
 30本目：名札作成（段組み）

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
23本目：シート構成の一致確認

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 23本目：シート構成の一致確認