VBA100本ノック 23本目:シート構成の一致確認
2つのブックのシート構成が一致しているかを確認する問題です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。
出題
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に入れて判定するのは良い方法だと思います。
何らかの対応をしておくに越したことはないでしょう。
さらに、ワークシートとグラフシートの違いもあるかもしれません。
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
サイト内関連ページ
同じテーマ「VBA100本ノック」の記事
20本目:ブックのバックアップ
21本目:バックアップファイルの削除
22本目:FizzBuzz発展問題
23本目:シート構成の一致確認
24本目:全角英数のみ半角
25本目:マトリックス表をDB形式に変換
25本目:マトリックス表をDB形式に変換
26本目:ファイル一覧作成
27本目:ハイパーリンクのURL
28本目:シートをブックに分割
29本目:画像の挿入
新着記事NEW ・・・新着記事一覧を見る
VBA100本ノック 99本目:自動席替え(行列と前後左右が全て違うように)|VBA練習問題(3月2日)
VBA100本ノック 98本目:席替えルールが守られているか確認|VBA練習問題(3月1日)
VBA100本ノック 97本目:Accessデータを取得(グループ集計)|VBA練習問題(2月27日)
VBA100本ノック 96本目:Accessデータを取得(マスタ結合&抽出)|VBA練習問題(2月26日)
VBA100本ノック 95本目:図形のテキストを検索するフォーム作成|VBA練習問題(2月24日)
VBA100本ノック 94本目:表範囲からHTMLのtableタグを作成|VBA練習問題(2月23日)
VBA100本ノック 93本目:複数ブックを連結して再分割|VBA練習問題(2月22日)
VBA100本ノック 92本目:セルの色を16進で返す関数|VBA練習問題(2月20日)
VBA100本ノック 91本目:時間計算(残業時間の月間合計)|VBA練習問題(2月19日)
VBA100本ノック 90本目:セルに重なっている画像の削除|VBA練習問題(2月17日)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
6.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
7.繰り返し処理(For Next)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.マクロはどこに書くの(VBEの起動)|VBA入門
10.とにかく書いてみよう(Sub,End Sub)|VBA入門
- ホーム
- マクロVBA入門編
- VBA100本ノック
- 23本目:シート構成の一致確認
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。