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

VBAを100本の練習問題で鍛えます
最終更新日:2020-11-13

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


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


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


出題

出題ツイートへのリンク

#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)
      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


シート名の比較方法として、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,...) このように、最後が「,...」となっていて、いくつでも(限度はありますが)指定できる関数です。




同じテーマ「Python入門」の記事

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


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

VBA100本ノック 34本目:配列の左右回転|VBA練習問題(11月28日)
VBA100本ノック 33本目:マクロ記録の改修|VBA練習問題(11月26日)
VBA100本ノック 32本目:Excel終了とテキストファイル出力|VBA練習問題(11月25日)
VBA100本ノック 31本目:入力規則|VBA練習問題(11月24日)
将棋とプログラミングについて~そこには型がある~|エクセル雑感(11月22日)
VBA100本ノック 30本目:名札作成(段組み)|VBA練習問題(11月22日)
VBA100本ノック 29本目:画像の挿入|VBA練習問題(11月21日)
VBA100本ノック 28本目:シートをブックに分割|VBA練習問題(11月19日)
VBA100本ノック 27本目:ハイパーリンクのURL|VBA練習問題(11月18日)
VBA100本ノック 26本目:ファイル一覧作成|VBA練習問題(11月17日)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
5.マクロって何?VBAって何?|VBA入門
6.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
7.繰り返し処理(For Next)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.とにかく書いてみよう(Sub,End Sub)|VBA入門
10.マクロはどこに書くの(VBEの起動)|VBA入門




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


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



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