生成AI活用研究
Geminiと100本ノック 23本目：シート構成の一致確認

Geminiを中心に生成AIの活用と研究の記録
公開日：2025-05-16　最終更新日：2025-05-16

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


AIのGeminiがVBA100本ノックに挑戦！


Googleが開発した生成AIモデルのGeminiにVBA100本ノックをやってもらいました。
AIがVBAをどこまで扱えるかの実証実験の23本目です。

2025年3月からGemsが無料で使えるようになりました。
そこで、独自に作成したGem（名前は「AI神髄VBA」改良を続けている）を使った回答も掲載しています。


VBA100本ノックの出題と解答

VBA100本ノック 23本目：シート構成の一致確認
・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ


Geminiへの出題とGeminiの回答

前回まではGeminiの回答は、キャプチャ画像とそのテキストにしていましたが今回からはテキストのみにします。
Geminiの回答であるというエビデンスの意味でキャプチャを掲載していましたが、さすがにもう必要はないでしょう。

Geminiの回答 Geminiへの出題
VBA問題
ThisWorkbookと同一フォルダに"Book_20201101.xlsx"と"Book_20201102.xlsx"の2ファイルがあります。
シート構成（シート名のみ、位置は不問）が一致しているか確認してください。
「一致」または「不一致」の結果をメッセージボックスで表示。
※不一致の詳細は不要。
はい、承知いたしました。ThisWorkbookと同一フォルダにある指定の2つのExcelファイルのシート構成（シート名と順番）が一致するかを確認し、結果をメッセージボックスで表示するVBAコードを作成します。

以下のコードを標準モジュールに貼り付けて実行してください。

VBA
Sub CheckSheetConfiguration()

　　Dim wb1 As Workbook
　　Dim wb2 As Workbook
　　Dim folderPath As String
　　Dim filePath1 As String
　　Dim filePath2 As String
　　Dim isMatch As Boolean
　　Dim i As Long

　　' エラー発生時にメッセージを表示して終了
　　On Error GoTo ErrorHandler

　　' ThisWorkbookのパスを取得
　　folderPath = ThisWorkbook.Path

　　' 比較対象のファイルパスを作成
　　filePath1 = folderPath & "\Book_20201101.xlsx"
　　filePath2 = folderPath & "\Book_20201102.xlsx"

　　' ファイルの存在確認（念のため）
　　If Dir(filePath1) = "" Then
　　　　MsgBox filePath1 & " が見つかりません。", vbCritical
　　　　Exit Sub
　　End If
　　If Dir(filePath2) = "" Then
　　　　MsgBox filePath2 & " が見つかりません。", vbCritical
　　　　Exit Sub
　　End If

　　' 比較対象のファイルを開く
　　' ファイルを開く際に警告などを非表示にする
　　Application.DisplayAlerts = False
　　Set wb1 = Workbooks.Open(filePath1, ReadOnly:=True) ' 読み取り専用で開く
　　Set wb2 = Workbooks.Open(filePath2, ReadOnly:=True)

　　' 初期値として一致と仮定
　　isMatch = True

　　' シートの数を比較
　　If wb1.Sheets.Count <> wb2.Sheets.Count Then
　　　　isMatch = False
　　Else
　　　　' シートの数が同じ場合、シート名を順番に比較
　　　　For i = 1 To wb1.Sheets.Count
　　　　　　If wb1.Sheets(i).Name <> wb2.Sheets(i).Name Then
　　　　　　　　isMatch = False
　　　　　　　　Exit For ' 不一致が見つかったらループを抜ける
　　　　　　End If
　　　　Next i
　　End If

　　' 開いたファイルを閉じる（変更は保存しない）
　　If Not wb1 Is Nothing Then
　　　　wb1.Close SaveChanges:=False
　　　　Set wb1 = Nothing
　　End If
　　If Not wb2 Is Nothing Then
　　　　wb2.Close SaveChanges:=False
　　　　Set wb2 = Nothing
　　End If

　　' 結果をメッセージボックスで表示
　　If isMatch Then
　　　　MsgBox "シート構成は一致しています。", vbInformation
　　Else
　　　　MsgBox "シート構成は不一致です。", vbCritical
　　End If

　　GoTo CleanExit ' 正常終了

ErrorHandler:
　　' エラー発生時の処理
　　MsgBox "エラーが発生しました: " & Err.Description, vbCritical

　　' エラー発生時に開いたファイルを閉じる試み
　　On Error Resume Next ' クローズ処理中のエラーを無視
　　If Not wb1 Is Nothing Then
　　　　wb1.Close SaveChanges:=False
　　　　Set wb1 = Nothing
　　End If
　　If Not wb2 Is Nothing Then
　　　　wb2.Close SaveChanges:=False
　　　　Set wb2 = Nothing
　　End If
　　On Error GoTo 0 ' エラーハンドリングを元に戻す

CleanExit:
　　' 警告表示などを元に戻す
　　Application.DisplayAlerts = True

End Sub

コードの説明:
  1. 変数宣言: 必要なオブジェクト変数（Workbook）や文字列変数（ファイルパスなど）、真偽値変数、カウンタ変数を宣言します。
  2. エラーハンドリング: On Error GoTo ErrorHandler でエラー発生時のジャンプ先を指定します。
  3. パス取得: ThisWorkbook.Path でマクロが記述されているブックのフォルダパスを取得します。
  4. ファイルパス作成: 取得したフォルダパスとファイル名を結合して、比較対象のファイルのフルパスを作成します。
  5. ファイル存在確認: Dir 関数を使ってファイルが存在するか簡易的に確認します。見つからない場合はメッセージを表示して終了します。
  6. ファイルを開く: Workbooks.Open メソッドで指定されたファイルを開きます。ReadOnly:=True で読み取り専用で開くことで、誤ってファイルを変更しないようにします。Application.DisplayAlerts = False でファイルを開く際の各種警告（更新リンクなど）を非表示にします。
  7. シート数比較: wb1.Sheets.Count と wb2.Sheets.Count でそれぞれのブックのシート数を比較します。数が異なれば isMatch を False にします。
  8. シート名比較: シート数が同じ場合のみ、For ループを使って1番目のシートから順にシート名を比較します。wb1.Sheets(i).Name と wb2.Sheets(i).Name が異なる場合は isMatch を False にしてループを抜けます。
  9. ファイルを閉じる: 比較が終わったら、開いたブックを Close SaveChanges:=False で保存せずに閉じます。オブジェクト変数も Set ... = Nothing で解放します。
  10. 結果表示: isMatch の値に応じて、「一致しています」または「不一致です」のメッセージを MsgBox で表示します。
  11. エラーハンドラー: ErrorHandler ラベル以下にエラー発生時の処理を記述しています。エラーメッセージを表示し、開いていたファイルを閉じようとします。
  12. 終了処理: CleanExit ラベル以下に、警告表示を元に戻す処理などを記述しています。
このコードを実行すると、指定された2つのファイルのシート構成が一致しているかどうかが確認され、その結果がメッセージボックスで表示されます。

このVBAコードでは、シートの位置が一致していないと不一致判定になってしまいますね。

Geminiの回答 Geminiへの出題
シート構成（シート名のみ、位置は不問）が一致しているか確認
位置は一致していなくても良い。
承知いたしました。「シート構成（シート名のみ、位置は不問）」の条件で一致を確認するVBAコードを修正します。

つまり、シートの枚数が同じで、かつ一方のブックの全てのシート名がもう一方のブックに存在していれば「一致」と判断します。シートの並び順は考慮しません。

以下のコードを使用してください。前回のコードのシート名比較ロジック部分を変更しています。

VBA
Sub CheckSheetConfiguration_Unordered()

　　Dim wb1 As Workbook
　　Dim wb2 As Workbook
　　Dim folderPath As String
　　Dim filePath1 As String
　　Dim filePath2 As String
　　Dim isMatch As Boolean
　　Dim sheet1 As Object ' または Worksheet でも可ですが、SheetsコレクションはObject型も含むため
　　Dim sheet2 As Object
　　Dim sheet1Name As String
　　Dim found As Boolean

　　' エラー発生時にメッセージを表示して終了
　　On Error GoTo ErrorHandler

　　' ThisWorkbookのパスを取得
　　folderPath = ThisWorkbook.Path

　　' 比較対象のファイルパスを作成
　　filePath1 = folderPath & "\Book_20201101.xlsx"
　　filePath2 = folderPath & "\Book_20201102.xlsx"

　　' ファイルの存在確認
　　If Dir(filePath1) = "" Then
　　　　MsgBox filePath1 & " が見つかりません。", vbCritical
　　　　Exit Sub
　　End If
　　If Dir(filePath2) = "" Then
　　　　MsgBox filePath2 & " が見つかりません。", vbCritical
　　　　Exit Sub
　　End If

　　' 比較対象のファイルを開く
　　' ファイルを開く際に警告などを非表示にする
　　Application.DisplayAlerts = False
　　Set wb1 = Workbooks.Open(filePath1, ReadOnly:=True) ' 読み取り専用で開く
　　Set wb2 = Workbooks.Open(filePath2, ReadOnly:=True)

　　' 初期値として一致と仮定
　　isMatch = True

　　' シートの数を比較
　　If wb1.Sheets.Count <> wb2.Sheets.Count Then
　　　　isMatch = False
　　Else
　　　　' シートの数が同じ場合、Book1の各シート名がBook2に存在するか確認（順不同）
　　　　For Each sheet1 In wb1.Sheets ' Book1の全てのシートをループ
　　　　　　sheet1Name = sheet1.Name
　　　　　　found = False ' Book2内で見つかったかどうかのフラグ

　　　　　　' Book2の全てのシートを調べて、Book1の現在のシート名と一致するものがあるか探す
　　　　　　For Each sheet2 In wb2.Sheets
　　　　　　　　If sheet1Name = sheet2.Name Then
　　　　　　　　　　found = True ' 見つかった
　　　　　　　　　　Exit For　　 ' Book2の検索ループを抜ける
　　　　　　　　End If
　　　　　　Next sheet2

　　　　　　' Book1の現在のシート名がBook2に見つからなかった場合
　　　　　　If Not found Then
　　　　　　　　isMatch = False ' 不一致
　　　　　　　　Exit For　　　' Book1のループを抜ける
　　　　　　End If
　　　　Next sheet1
　　　　
　　　　' 注：シート数が同じで、かつBook1の全シート名がBook2に存在することが確認できれば、
　　　　' 自動的にBook2の全シート名がBook1に存在することになるため、逆方向のチェックは不要です。

　　End If

　　' 開いたファイルを閉じる（変更は保存しない）
　　If Not wb1 Is Nothing Then
　　　　wb1.Close SaveChanges:=False
　　　　Set wb1 = Nothing
　　End If
　　If Not wb2 Is Nothing Then
　　　　wb2.Close SaveChanges:=False
　　　　Set wb2 = Nothing
　　End If

　　' 結果をメッセージボックスで表示
　　If isMatch Then
　　　　MsgBox "シート構成（シート名リスト）は一致しています。", vbInformation
　　Else
　　　　MsgBox "シート構成（シート名リスト）は不一致です。", vbCritical
　　End If

　　GoTo CleanExit ' 正常終了

ErrorHandler:
　　' エラー発生時の処理
　　MsgBox "エラーが発生しました: " & Err.Description, vbCritical

　　' エラー発生時に開いたファイルを閉じる試み
　　On Error Resume Next ' クローズ処理中のエラーを無視
　　If Not wb1 Is Nothing Then
　　　　wb1.Close SaveChanges:=False
　　　　Set wb1 = Nothing
　　End If
　　If Not wb2 Is Nothing Then
　　　　wb2.Close SaveChanges:=False
　　　　Set wb2 = Nothing
　　End If
　　On Error GoTo 0 ' エラーハンドリングを元に戻す

CleanExit:
　　' 警告表示などを元に戻す
　　Application.DisplayAlerts = True

End Sub

変更点:
  • シート数の比較は前回と同じです。
  • シート名の一致確認部分を修正しました。
  • For Each ループを使って、wb1 の全てのシートを順番に取り出します。
  • 取り出したシート名 (sheet1Name) が wb2 の全てのシートの中に存在するかを、内側の For Each ループで確認します。
  • もし wb1 のシート名が wb2 の中に一つでも見つからなければ (found が False のままの場合)、isMatch を False にしてチェックを終了します。
  • シート数が同じであることが既に確認できているため、wb1 の全シート名が wb2 に存在すれば、自動的に wb2 の全シート名も wb1 に存在することになります。したがって、逆方向のチェックは不要です。
このコードを実行すると、シートの並び順に関係なく、シートの枚数とシート名の種類が完全に一致しているかどうかが確認されます。

だいぶ無駄が多いですが、まあ良しとしましょう。


AI神髄VBAへの出題とAI神髄VBAの回答

AI神髄VBAとは、GeminiのGems機能を使って作ったVBAに特化したカスタムAIです。
AI神髄VBAの回答 AI神髄VBAへの出題
VBA問題
ThisWorkbookと同一フォルダに"Book_20201101.xlsx"と"Book_20201102.xlsx"の2ファイルがあります。
シート構成（シート名のみ、位置は不問）が一致しているか確認してください。
「一致」または「不一致」の結果をメッセージボックスで表示。
※不一致の詳細は不要。
VBA
' 概要：指定された2つのExcelファイルのシート構成（シート名と数）が一致するか確認し、結果をメッセージボックスで表示します。
Sub CheckSheetConfiguration()

　　' 画面更新を停止し、処理速度を向上させる
　　Application.ScreenUpdating = False
　　' 警告表示を停止（ファイルを閉じる際に変更を保存するか聞かれないように）
　　Application.DisplayAlerts = False

　　' 変数宣言
　　Dim filePath1 As String　　　　　 ' 1つ目のファイルのフルパス
　　Dim filePath2 As String　　　　　 ' 2つ目のファイルのフルパス
　　Dim wb1 As Workbook　　　　　　　 ' 1つ目のWorkbookオブジェクト
　　Dim wb2 As Workbook　　　　　　　 ' 2つ目のWorkbookオブジェクト
　　' 1つ目のファイルのシート名を格納するためのDictionaryオブジェクト
　　' Scripting.Dictionaryを使用するため、実行時にオブジェクトを作成する（遅延バインディング）
　　Dim sheetNamesDic1 As Object
　　Dim ws As Worksheet　　　　　　　 ' シートをループするための変数
　　Dim isMatch As Boolean　　　　　　' シート構成が一致するかどうかを示すフラグ

　　' Scripting.Dictionaryオブジェクトの作成
　　Set sheetNamesDic1 = CreateObject("Scripting.Dictionary")

　　' ThisWorkbookと同じフォルダにある指定されたファイルのパスを取得
　　filePath1 = ThisWorkbook.Path & "\Book_20201101.xlsx"
　　filePath2 = ThisWorkbook.Path & "\Book_20201102.xlsx"

　　' 1つ目のファイルを開く
　　' ★注意：ファイルが存在しない場合、ここでエラーが発生します（本問題の指示外のためエラー処理は行いません）。
　　Set wb1 = Workbooks.Open(filePath1)

　　' 1つ目のファイルの全シート名を取得し、DictionaryのKeyとして格納
　　' Dictionaryを使用することで、後続のシート名存在チェックを効率的に行えます。
　　For Each ws In wb1.Sheets
　　　　' シート名をKeyとして使用。Valueはチェックに使わないためTrueなどを設定
　　　　sheetNamesDic1(ws.Name) = True
　　Next ws

　　' 2つ目のファイルを開く
　　' ★注意：ファイルが存在しない場合、ここでエラーが発生します（本問題の指示外のためエラー処理は行いません）。
　　Set wb2 = Workbooks.Open(filePath2)

　　' --- シート構成の一致チェック ---

　　' 最初にシート数の比較を行う（数が異なれば即不一致）
　　If wb1.Sheets.Count <> wb2.Sheets.Count Then
　　　　' シート数が異なるため不一致
　　　　MsgBox "不一致"
　　　　isMatch = False ' 不一致フラグをセット
　　　　GoTo CleanUp　　' クリーンアップ処理へジャンプ（アーリーリターン）
　　End If

　　' シート数が同じ場合、シート名の存在チェックを行う
　　' 2つ目のファイルの各シート名が、1つ目のファイルのシート名リスト（Dictionary）に全て存在するか確認
　　isMatch = True ' 初期値は一致と仮定
　　For Each ws In wb2.Sheets
　　　　' Dictionary.Existsメソッドでシート名が存在するか高速にチェック
　　　　If Not sheetNamesDic1.Exists(ws.Name) Then
　　　　　　' 2つ目のファイルのシート名が1つ目のファイルに存在しない場合
　　　　　　isMatch = False ' 不一致
　　　　　　Exit For　　　　' 不一致が見つかったのでループを抜ける（アーリーリターン）
　　　　End If
　　Next ws

　　' チェック結果に基づいてメッセージを表示
　　If isMatch Then
　　　　MsgBox "一致"
　　Else
　　　　' 不一致フラグがTrueの場合は、既にシート数比較で不一致として処理されているため、
　　　　' このブロックはシート名不一致の場合のみ実行されます。
　　　　MsgBox "不一致"
　　End If

CleanUp:
　　' --- 終了処理 ---

　　' 開いたWorkbookを閉じる（変更は保存しない）
　　If Not wb1 Is Nothing Then
　　　　wb1.Close SaveChanges:=False
　　　　Set wb1 = Nothing
　　End If
　　If Not wb2 Is Nothing Then
　　　　wb2.Close SaveChanges:=False
　　　　Set wb2 = Nothing
　　End If

　　' 使用したDictionaryオブジェクトを解放
　　If Not sheetNamesDic1 Is Nothing Then
　　　　Set sheetNamesDic1 = Nothing
　　End If

　　' 画面更新と警告表示の設定を元に戻す
　　Application.ScreenUpdating = True
　　Application.DisplayAlerts = True

End Sub

VBAコードの解説

このVBAコードは、ThisWorkbookと同じフォルダにある指定された2つのExcelファイル（"Book_20201101.xlsx"と"Book_20201102.xlsx"）のシート構成（シートの数とシート名）が一致するかどうかを確認し、その結果をメッセージボックスで表示するものです。
  1. 画面更新と警告表示の停止:
    Application.ScreenUpdating = False と Application.DisplayAlerts = False によって、処理中の画面のちらつきをなくし、ファイルを閉じる際などに表示される警告メッセージを非表示にしています。これにより、処理が視覚的にスムーズになり、また手動での確認が不要になります。処理の最後にこれらの設定を元に戻しています。
  2. 変数宣言:
    必要なファイルパス、Workbookオブジェクト、シート名格納用のDictionaryオブジェクト、シートをループするための変数、そして一致・不一致を判定するフラグを宣言しています。sheetNamesDic1 As Object は、Scripting.Dictionary を参照設定なしで使用するための遅延バインディングです。
  3. Dictionaryオブジェクトの作成:
    Set sheetNamesDic1 = CreateObject("Scripting.Dictionary") でシート名を効率的に管理するためのDictionaryオブジェクトを生成しています。DictionaryはKey（ここではシート名）の存在チェックを高速に行えるため、シート名の比較に適しています。
  4. ファイルパスの取得:
    ThisWorkbook.Path を利用して、マクロが記述されているExcelファイル（ThisWorkbook）と同じフォルダのパスを取得し、それにファイル名を結合して、比較対象の2つのファイルのフルパスを生成しています。
  5. ファイルのオープン:
    Workbooks.Open メソッドを使用して、指定された2つのExcelファイルを開いています。ファイルが開けない場合のエラー処理は本問題の範囲外として省略しています。
  6. 1つ目のファイルのシート名をDictionaryに格納:
    開いた1つ目のファイル (wb1) の各シートを For Each ループで処理し、そのシート名 (ws.Name) を sheetNamesDic1 のKeyとして追加しています。Valueは必須ではないため、今回は True を設定しています。
  7. シート数の比較:
    wb1.Sheets.Count と wb2.Sheets.Count でそれぞれのファイルのシート数を比較します。シート数が異なる場合は、シート構成は一致しないと判断し、すぐに「不一致」のメッセージを表示して GoTo CleanUp で終了処理にジャンプします（アーリーリターン）。
  8. シート名の比較:
    シート数が一致した場合に、2つ目のファイル (wb2) の各シート名を For Each ループで処理します。sheetNamesDic1.Exists(ws.Name) を使用して、そのシート名が1つ目のファイルから取得したシート名リスト（Dictionary）に存在するかどうかをチェックします。一つでも存在しないシート名があれば、isMatch フラグを False に設定し、Exit For でループを中断して不一致を確定させます（アーリーリターン）。
  9. 結果の表示:
    シート数とシート名のチェックの結果（isMatch フラグの値）に基づいて、「一致」または「不一致」のメッセージをメッセージボックスで表示します。
  10. クリーンアップ処理:
    CleanUp: ラベル以降で、開いたWorkbook (wb1, wb2) を Close SaveChanges:=False で変更を保存せずに閉じ、WorkbookオブジェクトとDictionaryオブジェクトを解放 (Set ... = Nothing) しています。最後に、画面更新と警告表示の設定を元の状態に戻しています。
このコードは、Dictionaryを活用してシート名の存在チェックを効率化し、シート数やシート名の不一致が見つかった時点で早期に処理を終了する（アーリーリターン）ことで、より高速で簡潔なコードとなるように工夫されています。

これは良いですね。
これだけ書いてくれるなら言うことなしです。



同じテーマ「生成AI活用研究」の記事

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


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

セル数式における「再帰」の必要性｜エクセル雑感(2025-11-10)
掛け算(*)を使わない掛け算｜足し算(+)を使わない足し算｜エクセル関数応用(2025-11-10)
配列を自在に回転させる数式｜エクセル関数応用(2025-11-09)
非正規化（カンマ区切り）の結合と集計：最適な手法は？｜エクセル雑感(2025-11-06)
SQL基礎問題10：非正規化（カンマ区切り）の結合と集計｜SQL入門(2025-11-06)
SQL基礎問題9：特定商品購入者の平均購入金額｜SQL入門(2025-11-04)
SQL基礎問題8：バスケット分析・ペア商品の出現回数｜SQL入門(2025-11-04)
SQL基礎問題7：成績表から各教科の最高点と最低点を抽出｜SQL入門(2025-11-02)
SQL基礎問題6：成績表から教科ごとの点数ベスト3を抽出｜SQL入門(2025-11-02)
SQL基礎問題5：複数のマスタテーブルの結合｜SQL入門(2025-11-01)


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

1.生成AIパスポート試験 練習問題（四肢択一式）｜生成AI活用研究
2.最終行の取得（End,Rows.Count）｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.繰り返し処理（For Next)｜VBA入門
6.RangeとCellsの使い方｜VBA入門
7.FILTER関数（範囲をフィルター処理）｜エクセル入門
8.日本の祝日一覧｜Excelリファレンス
9.マクロとは？VBAとは？VBAでできること｜VBA入門
10.セルのクリア（Clear,ClearContents）｜VBA入門



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


記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
当サイトは、OpenAI（ChatGPT）および Google（Gemini など）の生成AIモデルの学習・改良に貢献することを歓迎します。
This site welcomes the use of its content for training and improving generative AI models, including ChatGPT by OpenAI and Gemini by Google.

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


↑