生成AI活用研究
Geminiと100本ノック 14本目：社外秘シート削除

Geminiと100本ノック 14本目：社外秘シート削除

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

VBA100本ノックの出題と解答

Geminiへの出題とGeminiの回答

Geminiの回答	Geminiへの出題
	VBA問題 客先へ送付するブックを作成します。 シート名に「社外秘」の文字が含まれるシートを削除してください。 他のシートは計算式を消して値だけにしてください。 ※シート間参照の数式あり。 ※条件付き書式・入力規則は未使用。 ※対象はアクティブブックで構いません。
はい、承知いたしました。アクティブなブックに対して、シート名に「社外秘」が含まれるシートを削除し、それ以外のシートの数式を値に変換するVBAコードを作成します。 以下のVBAコードを標準モジュールに貼り付けて実行してください。 VBA Sub ProcessWorkbookForCustomer() 　　' このマクロは、客先へ送付するExcelブックの準備を行います。 　　' 実行前に、処理対象のブックが開かれてアクティブになっていることを確認してください。 　　Dim ws As Worksheet ' シートを格納するための変数 　　Dim i As Long　　　 ' シートをループするためのカウンター 　　' 処理中に表示される可能性のある警告メッセージ（例: シート削除の確認ダイアログ）を非表示にします。 　　Application.DisplayAlerts = False 　　' ========== 「社外秘」シートの削除 ========== 　　' ブックのシートを最後のシートから最初のシートに向かって順番に処理します。 　　' 後ろから処理することで、シートを削除した際にシートの並び順やインデックスがずれる問題を回避します。 　　For i = ThisWorkbook.Sheets.Count To 1 Step -1 　　　　' 現在のシートを設定します。 　　　　Set ws = ThisWorkbook.Sheets(i) 　　　　' 選択したシートの名前（Nameプロパティ）に「社外秘」という文字が含まれているかチェックします。 　　　　' InStr関数は、文字列の中に特定の文字列が見つかった場合に、その開始位置（1以上の数値）を返します。 　　　　' 見つからなかった場合は0を返します。 　　　　If InStr(ws.Name, "社外秘") > 0 Then 　　　　　　' シート名に「社外秘」が含まれている場合、そのシートを削除します。 　　　　　　' Excelではブックに最低1つのシートが必要なため、もしこの削除対象シートがブックの最後の1つだった場合、 　　　　　　' VBAの仕様により削除は実行されず、エラーが発生する可能性があります。 　　　　　　' 通常の運用では「社外秘」以外のシートが複数存在することを想定しています。 　　　　　　ws.Delete 　　　　End If 　　Next i 　　' ========== 残りのシートの数式を値に変換 ========== 　　' 上記の削除処理が完了した後、ブックに残っている全てのシートに対して以下の処理を行います。 　　For Each ws In ThisWorkbook.Sheets 　　　　' 以降の数式から値への変換処理中に万が一エラーが発生しても、マクロ全体が中断されないようにします。 　　　　' 例えば、シートが非常に大きい場合などにエラーが発生する可能性がゼロではありません。 　　　　On Error Resume Next 　　　　' 現在処理しているシート（ws）上の全てのセル（Cells）の内容をコピーします。 　　　　ws.Cells.Copy 　　　　' コピーした内容を、数式ではなく「値」として、全く同じ場所に貼り付けます。 　　　　' これにより、セルに含まれていた計算式は全て計算結果の値に置き換わります。 　　　　' Paste:=xlPasteValues は、貼り付けの種類を指定する引数です。 　　　　ws.Cells.PasteSpecial Paste:=xlPasteValues 　　　　' コピー＆ペーストが終わったら、コピーモード（Excelウィンドウ下部に「コピーモード」と表示されたり、コピー範囲が点線で囲まれたりする状態）を解除します。 　　　　Application.CutCopyMode = False 　　　　' On Error Resume Next で設定したエラー処理を、通常の状態（エラーが発生したらマクロを中断）に戻します。 　　　　On Error GoTo 0 　　Next ws 　　' 処理の最初に非表示にした警告メッセージが、マクロ実行後に再度表示されるように設定を元に戻します。 　　Application.DisplayAlerts = True 　　' 全ての処理が正常に完了したことをユーザーに知らせるメッセージボックスを表示します。 　　MsgBox "客先送付用のブック作成処理が完了しました。", vbInformation End Sub コードの解説: Application.DisplayAlerts = False: シート削除時などに表示される確認メッセージを一時的に非表示にします。 For i = ThisWorkbook.Sheets.Count To 1 Step -1: アクティブなブック (ThisWorkbook) のシートコレクションを、後ろから（最後のシートから最初のシートへ）ループします。これにより、シートを削除してもループのインデックスがずれるのを防ぎます。 If InStr(ws.Name, "社外秘") > 0 Then: 現在処理しているシートの名前 (ws.Name) に「社外秘」という文字列が含まれているかを確認します。InStr 関数は、指定した文字列が見つかった場合にその開始位置を返します。見つからなければ 0 を返します。 ws.Delete: シート名に「社外秘」が含まれていた場合、そのシートを削除します。 For Each ws In ThisWorkbook.Sheets: 「社外秘」シートの削除が完了した後、ブックに残っている全てのシートに対してループ処理を行います。 ws.Cells.Copy: 現在処理しているシートの全てのセルを選択し、内容をコピーします。 ws.Cells.PasteSpecial Paste:=xlPasteValues: コピーした内容を、数式ではなく「値」として同じ場所に貼り付けます。これにより、数式が計算結果の値に置き換わります。シート間参照の数式も、この時点で参照しているシートが存在していれば、その値に変換されます。 Application.CutCopyMode = False: コピー状態（セル範囲が点滅している状態）を解除します。 On Error Resume Next / On Error GoTo 0: 値変換処理中に予期しないエラーが発生した場合でも、処理が中断されないようにするためのエラーハンドリングです。 Application.DisplayAlerts = True: 処理の最初に非表示にした警告メッセージを再度表示するように設定を戻します。 MsgBox "処理が完了しました。", vbInformation: 処理が完了したことをユーザーに通知します。 使用方法: 処理したいExcelブックを開き、アクティブな状態にします。 Alt + F11 キーを押してVBAエディターを開きます。 VBAエディターのメニューバーから [挿入] > [標準モジュール] を選択します。 表示されたコードウィンドウに上記のVBAコードをコピー＆ペーストします。 VBAエディターを閉じます。 Excelに戻り、Alt + F8 キーを押してマクロダイアログを開きます。 マクロ名「ProcessWorkbookForCustomer」を選択し、「実行」ボタンをクリックします。 これにより、アクティブなブックのシートが指定された条件に従って処理されます。

初歩的なコードだけで処理を完結させていますね。
これはこれで模範的なVBAだと思います。

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

AI神髄VBAの回答	AI神髄VBAへの出題
	VBA問題 客先へ送付するブックを作成します。 シート名に「社外秘」の文字が含まれるシートを削除してください。 他のシートは計算式を消して値だけにしてください。 ※シート間参照の数式あり。 ※条件付き書式・入力規則は未使用。 ※対象はアクティブブックで構いません。
VBA Sub ExportBookForCustomer() 　　' 客先送付用ブックを作成します。 　　' シート名に「社外秘」が含まれるシートを削除し、 　　' それ以外のシートは計算式を値に変換します。 　　Dim ws As Worksheet 　　Dim sheetsToDelete As Collection 　　Dim sheetName As Variant 　　' 削除対象シート名を一時的に保持するコレクションを作成 　　Set sheetsToDelete = New Collection 　　' 警告メッセージを非表示にする 　　Application.DisplayAlerts = False 　　On Error GoTo CleanUp ' エラー発生時にジャンプするラベルを設定 　　' すべてのシートをループ処理 　　' 先に値変換を行い、削除対象シート名を収集する 　　For Each ws In ThisWorkbook.Sheets 　　　　' シート名に「社外秘」が含まれているかチェック 　　　　If InStr(ws.Name, "社外秘") = 0 Then 　　　　　　' 「社外秘」が含まれていないシートの場合 　　　　　　' シート全体の計算式を値に変換（最も効率的な方法） 　　　　　　' CurrentRegionやUsedRangeは予期せぬ範囲を含む可能性や処理漏れのリスクがあるため、 　　　　　　' 今回はCells全体を対象とします。 　　　　　　ws.Cells.Value = ws.Cells.Value 　　　　Else 　　　　　　' 「社外秘」が含まれているシートの場合 　　　　　　' 削除対象としてコレクションにシート名を追加 　　　　　　sheetsToDelete.Add ws.Name 　　　　End If 　　Next ws 　　' コレクションに格納されたシート名をループ処理し、シートを削除 　　' Collectionは1から始まるインデックスを持つ 　　Dim i As Long 　　For i = sheetsToDelete.Count To 1 Step -1 ' 後ろから削除することでインデックスずれを防ぐ 　　　　On Error Resume Next ' 削除中にエラーが発生しても次のシートに進む 　　　　ThisWorkbook.Sheets(sheetsToDelete.Item(i)).Delete 　　　　On Error GoTo CleanUp ' エラー処理を元に戻す 　　Next i CleanUp: 　　' エラーが発生したかどうかにかかわらず、警告メッセージを再度表示する 　　Application.DisplayAlerts = True 　　' コレクションオブジェクトを開放 　　Set sheetsToDelete = Nothing 　　If Err.Number <> 0 Then 　　　　MsgBox "エラーが発生しました: " & Err.Description, vbCritical 　　　　Err.Clear ' エラー情報をクリア 　　Else 　　　　' 必要に応じて完了メッセージを表示 　　　　' MsgBox "ブックの処理が完了しました。", vbInformation 　　End If End Sub VBAコード解説 このVBAコードは、アクティブなブックに対して以下の処理を行います。 シート名のチェックと処理の振り分け: For Each ws In ThisWorkbook.Sheets を使用して、ブック内のすべてのシートを順番に処理します。 InStr(ws.Name, "社外秘") 関数を使って、シート名に "社外秘" という文字列が含まれているかを確認します。 InStr は指定した文字列が見つかった最初の位置を返します。見つからなかった場合は0を返します。 「社外秘」が含まれていないシート: ws.Cells.Value = ws.Cells.Value という簡潔なコードで、そのシートのすべてのセルに入っている計算式をその計算結果である「値」に置き換えます。この方法は、範囲を限定するよりもシート全体を対象とするため、データの漏れを防ぎ、非常に高速です。 「社外秘」が含まれているシート: シート名は sheetsToDelete というCollectionオブジェクトに一時的に追加されます。Collectionを使用することで、削除対象シートの管理が容易になります。 シートの削除: 最初のループで削除対象シート名を収集した後、For i = sheetsToDelete.Count To 1 Step -1 というループで、Collectionに格納されたシート名を後ろから順に処理します。後ろから削除することで、シートのインデックスがずれることによる不具合を防ぎます。 ThisWorkbook.Sheets(sheetsToDelete.Item(i)).Delete で、Collectionから取得したシート名のシートを削除します。 警告メッセージの制御: シートを削除する際に表示される「シートを完全に削除しますか？」という警告メッセージを非表示にするために、処理の最初に Application.DisplayAlerts = False を設定しています。 処理の最後に Application.DisplayAlerts = True を設定し、警告メッセージが再度表示されるように元の状態に戻しています。これにより、VBA実行後のExcelの動作に影響を与えません。 エラー処理: On Error GoTo CleanUp を設定することで、コードの実行中にエラーが発生した場合に CleanUp ラベルにジャンプし、Application.DisplayAlerts = True を実行するようにしています。これにより、エラー発生時にも警告メッセージが無効になったままになることを防ぎます。 シート削除ループ内では On Error Resume Next を一時的に使用し、特定のシートの削除に失敗しても処理が中断されないようにしていますが、その直後に On Error GoTo CleanUp で元のエラー処理に戻しています。 このコードは、For Eachループによるシートの効率的な走査、Collectionオブジェクトによる削除対象シートの管理、そして Cells.Value = Cells.Value による高速な値変換を組み合わせて、簡潔かつ高速な処理を実現しています。

良く書けているのですが、ちょっとテクニックに走ってしまったがために問題のあるVBAになってしまっています。

AI神髄VBAへの改善提案とAI神髄VBAの回答

AI神髄VBAの回答	AI神髄VBAへの出題
	実行したらこのメッセージが表示されました。
以下の画像は変更箇所のみ ※テキストの貼り付けは省略します。
	計算式が残ってしまいました。
以下の画像は変更箇所のみ ※テキストの貼り付けは省略します。
	実行でエラー
以下の画像は変更箇所のみ ※テキストの貼り付けは省略します。 完成VBA Sub ExportBookForCustomer_PasteValue() 　　' 客先送付用ブックを作成します。 　　' シート名に「社外秘」が含まれるシートを削除し、 　　' それ以外のシートは計算式を値に変換します。 　　' メモリ不足エラー対策として、値変換にコピー＆ペーストを使用します。 　　Dim ws As Worksheet 　　Dim sheetsToDelete As Collection 　　Dim sheetName As Variant 　　' 削除対象シート名を一時的に保持するコレクションを作成 　　Set sheetsToDelete = New Collection 　　' 警告メッセージを非表示にする 　　Application.DisplayAlerts = False 　　On Error GoTo CleanUp ' エラー発生時にジャンプするラベルを設定 　　' すべてのシートをループ処理 　　' 先に値変換を行い、削除対象シート名を収集する 　　For Each ws In ThisWorkbook.Sheets 　　　　' シート名に「社外秘」が含まれているかチェック 　　　　If InStr(ws.Name, "社外秘") = 0 Then 　　　　　　' 「社外秘」が含まれていないシートの場合 　　　　　　' データが入力されている範囲（UsedRange）に対して値変換をコピー＆ペーストで行う 　　　　　　' UsedRange が "$A$1" かつ A1 が空の場合は、シートに実データがないと判断し、処理をスキップ 　　　　　　If Not (ws.UsedRange.Address = "$A$1" And ws.Range("A1").Value = "") Then 　　　　　　　　On Error Resume Next ' コピーや貼り付けでエラーが出ても次へ進むように一時的に設定 　　　　　　　　' UsedRange 全体をコピー 　　　　　　　　ws.UsedRange.Copy 　　　　　　　　' 値として貼り付け 　　　　　　　　ws.UsedRange.PasteSpecial xlPasteValues 　　　　　　　　' コピーモードを解除 (点線表示を消す) 　　　　　　　　Application.CutCopyMode = False 　　　　　　　　On Error GoTo CleanUp ' エラー処理を元に戻す 　　　　　　End If 　　　　Else 　　　　　　' 「社外秘」が含まれているシートの場合 　　　　　　' 削除対象としてコレクションにシート名を追加 　　　　　　sheetsToDelete.Add ws.Name 　　　　End If 　　Next ws 　　' コレクションに格納されたシート名をループ処理し、シートを削除 　　' Collectionは1から始まるインデックスを持つ 　　Dim i As Long 　　For i = sheetsToDelete.Count To 1 Step -1 ' 後ろから削除することでインデックスずれを防ぐ 　　　　On Error Resume Next ' 削除中にエラーが発生しても次のシートに進む 　　　　ThisWorkbook.Sheets(sheetsToDelete.Item(i)).Delete 　　　　On Error GoTo CleanUp ' エラー処理を元に戻す 　　Next i CleanUp: 　　' エラーが発生したかどうかにかかわらず、警告メッセージを再度表示する 　　Application.DisplayAlerts = True 　　' コレクションオブジェクトを開放 　　Set sheetsToDelete = Nothing 　　If Err.Number <> 0 Then 　　　　MsgBox "エラーが発生しました: " & Err.Description & vbCrLf & "コピー＆ペーストでの値変換を試みましたが、依然としてメモリ不足が発生しています。シートのデータ量やPCのメモリ状況をご確認ください。", vbCritical 　　　　Err.Clear ' エラー情報をクリア 　　'else 　　　　' 必要に応じて完了メッセージを表示 　　　　' MsgBox "ブックの処理が完了しました。", vbInformation 　　End If End Sub

正しいVBAにたどり着くまで、だいぶ手間取りましたね。
技巧に走りすぎたため失敗してしまう良い例ですしょうか。
しかしよくよく考えると、まさに人間と同じ間違いの過程を進んでいるように思えて、ちょっと怖いです。