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

最終更新日：2021-03-18

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

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

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

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

出題

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

頂いた回答

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

解説

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


  
    
      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ステートメント

変数のデータ型の説明において、Object…オブジェクト型というのがあった事を覚えているでしょうか。数値や文字ではなく、オブジェクトを入れる変数がオブジェクト変数です。オブジェクトと言っても、いろいろなものがあります。

第53回．Workbookオブジェクト

Workbookオブジェクトは、ワークブックそのものです。1つのワークブックは、1つのExcelファイルです。マクロVBAで複数のブックを扱う場合や、ブックを読込んだり保存したりする場合は、Workbookオブジェクトをしっかり意識しつつVBAを記述しなければなりません。

第55回．Worksheetオブジェクト

Worksheetオブジェクトは、ワークシートそのものです。エクセルのマクロVBAですから、ワークシートはしっかりと扱えなければなりません。WorkSheetオブジェクトの集まりがWorkSheetsコレクションになります。

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

同種のオブジェクトを複数まとめたものを「コレクション」と呼びます、コレクションもオブジェクトの一種です。例えば、Workbookオブジェクトが複数まとまったものは「Workbooksコレクション」Worksheetオブジェクトが複数まとまったものは「Worksheetsコレクション」オブジェクト名が単数形であるのに対し、

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

ForEachは、コレクションの各要素に対して繰り返し処理を実行します。コレクションはオブジェクトの集まりですので、ForEachは、コレクションの中から、個別のオブジェクトを取り出して処理する場合に使用します。コレクションの全ての要素に対しての処理が終わるとループは終了します。

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

マクロを実行していると、エラーメッセージが表示されマクロ実行が停止してしまう事があります。マクロがエラー停止しては自動化の目的が達成されませんので、エラー停止しないようにしなければなりません。エラーが出ないようにVBAを記述出来ればそれに越したことはありませんが、一切エラーを出さないようにVBAを書くことはかなり困難なものです。

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

「OnErrorGoTo行ラベル」このステートメントは、実行時エラーが発生した時に、制御を指定の行ラベルに移動させるものです。マクロVBAは、エラーが発生するとその時点で停止してしまいます。VBAが実行不能となった場合に、エラー発生したVBAコードで停止します。

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

「OnErrorResumeNext」ステートメントは、実行時エラーが発生してもマクロVBAを中断せずに、エラーが発生したステートメントの次のステートメントから実行を継続します。マクロVBAは、エラーが発生するとその時点で停止してしまいます。

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

Subプロシージャー、Functionプロシージャーにおいて、引数リストの数を特定せず、不定個数の引数を渡せるよう可変にしたい場合があります。ワークシートの関数では、引数の個数が不定の関数が多数あります。=SUM(数値1,数値2,...) このように、最後が「,...」となっていて、いくつでも（限度はありますが）指定できる関数です。

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

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

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.Excelショートカットキー一覧｜Excelリファレンス
3.RangeとCellsの使い方｜VBA入門
4.マクロって何？VBAって何？｜VBA入門
5.変数宣言のDimとデータ型｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.ひらがな⇔カタカナの変換｜エクセル基本操作
8.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
9.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
10.セルに文字を入れるとは（Range,Value）｜VBA入門

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

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

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

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