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

VBAを100本の練習問題で鍛えます
最終更新日：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本目：名札作成（段組み）


新着記事NEW ・・・新着記事一覧を見る

新旧マスタの差異比較｜Power Query（M言語）入門(2023-02-28)
有効な最新単価の取得｜Power Query（M言語）入門(2023-02-26)
有効な最新単価の取得｜Power Query（M言語）入門(2023-02-21)
グルーブ内の最小・最大｜Power Query（M言語）入門(2023-02-17)
2つのテーブルのマージ｜Power Query（M言語）入門(2023-02-15)
「売上」が数値の行のみ取り込む｜Power Query（M言語）入門(2023-02-13)
A列のヘッダー名を変更する｜Power Query（M言語）入門(2023-02-11)
CSVのA列が日付の行だけを取り込む｜Power Query（M言語）入門(2023-02-10)
列数不定のCSVの取り込み｜Power Query（M言語）入門(2023-02-09)
別ブックの最終シートの取り込み｜Power Query（M言語）入門(2023-02-08)


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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.繰り返し処理（For Next)｜VBA入門
5.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
6.マクロって何？VBAって何？｜VBA入門
7.並べ替え（Sort）｜VBA入門
8.Excelショートカットキー一覧｜Excelリファレンス
9.エクセルVBAでのシート指定方法｜VBA技術解説
10.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門



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


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

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ
同じテーマの記事
新着記事
アクセスランク


↑