生成AIと100本ノック 28本目：シートをブックに分割
AIのGeminiがVBA100本ノックに挑戦！
ということでシリーズを開始しましたが、ある程度回もすすんだので、検証方法を変更することにしました。
そこで、このプロンプトのさらなる改善と最終検証を目的として、100本ノックを進めていくことにします。
🤖 Gemini（2.5 Pro）（課金済の有料版）
🤖 ChatGPT（GPT-3.5）（無課金の無料版）
🤖 Claude（Sonnet4）（無課金の無料版）
🤖 ChatGPT（GPT-3.5）（無課金の無料版）
🤖 Claude（Sonnet4）（無課金の無料版）
VBA100本ノックの出題と解答
生成AIへの出題
個人別のシートを個人別のブックに分けまます。
シート名は"部署_氏名"です。
ブックと同一フォルダに"部署"フォルダを作成し、シート名をブック名にして出力してください。
"部署1_日本 太郎"→"部署1"フォルダに"部署1_日本 太郎.xlsx"
※再実行を考慮
※対象ブックは任意
Geminiの回答
はい、承知いたしました。
Excel VBAを用いて、個人別のシートをそれぞれ個別のブックに分割し、指定されたフォルダ構成で保存する、業務品質レベルの自動化コードを作成します。
高速処理・堅牢性・保守性を考慮し、プロシージャーの機能分割、適切なエラーハンドリング、高速化設定などを盛り込んだ最適な設計で実装します。
作成したVBAコード
以下に、指定された要件に基づき作成したVBAコードを記載します。
このコードを標準モジュールにコピー＆ペーストしてご使用ください。
VBA
VBAコードの解説
Excel VBAを用いて、個人別のシートをそれぞれ個別のブックに分割し、指定されたフォルダ構成で保存する、業務品質レベルの自動化コードを作成します。
以下に、指定された要件に基づき作成したVBAコードを記載します。
このコードを標準モジュールにコピー＆ペーストしてご使用ください。
'================================================================================
' Module: ModSplitSheets
' Author: Gemini
' Date: 2025/06/08
' Description: アクティブブックの各シートを、ルールに基づいて個別のブックに分割して保存するモジュール。
'================================================================================
Option Explicit
'--------------------------------------------------------------------------------
' メインプロシージャー
'--------------------------------------------------------------------------------
Public Sub SplitSheetsToIndividualBooks()
'-----------------------------------------
' 機能: 全シートをループし、個別のブックとして保存する処理を起動する
' 引数: なし
' 戻り値: なし
' 備考: 処理の起点となる。高速化設定、エラーハンドリングを管理する。
'-----------------------------------------
Dim wb As Workbook
Dim ws As Object ' Worksheet
Dim strBasePath As String
Dim lSheetCount As Long
Dim lProcessedCount As Long
Dim lSkippedCount As Long
On Error GoTo ErrorHandler
' 高速化設定
Call SetApplicationSettings(False)
Set wb = ThisWorkbook
' ブックが一度も保存されていない場合は処理を中断
If wb.Path = "" Then
MsgBox "このブックはまだ保存されていません。一度保存してから実行してください。", vbExclamation, "処理中断"
GoTo CleanUp
End If
strBasePath = wb.Path
lSheetCount = wb.Worksheets.Count
lProcessedCount = 0
lSkippedCount = 0
' 全シートをループ処理
For Each ws In wb.Worksheets
' シートをブックとして分割処理
If ProcessSheet(ws, strBasePath) Then
lProcessedCount = lProcessedCount + 1
Else
' シート名に"_"が含まれていないなど、処理対象外だったシート
lSkippedCount = lSkippedCount + 1
End If
Next ws
' 処理結果をメッセージボックスで表示
MsgBox "処理が完了しました。" & vbCrLf & vbCrLf & _
"保存件数: " & lProcessedCount & " 件" & vbCrLf & _
"スキップ件数: " & lSkippedCount & " 件" & vbCrLf & _
"--------------------" & vbCrLf & _
"合計シート数: " & lSheetCount & " 件", vbInformation, "処理完了"
CleanUp:
' 各種設定を元に戻す
Call SetApplicationSettings(True)
Set wb = Nothing
Set ws = Nothing
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました。処理を中断します。" & vbCrLf & vbCrLf & _
"エラー番号: " & Err.Number & vbCrLf & _
"エラー内容: " & Err.Description & vbCrLf & _
"発生プロシージャ: SplitSheetsToIndividualBooks", vbCritical, "エラー"
Resume CleanUp
End Sub
'--------------------------------------------------------------------------------
' データ加工・ロジックプロシージャー
'--------------------------------------------------------------------------------
Private Function ProcessSheet(ByVal wsTarget As Worksheet, ByVal strBasePath As String) As Boolean
'-----------------------------------------
' 機能: 1枚のシートを個別のブックとして保存する
' 引数: wsTarget (Worksheet) - 処理対象のシート
' strBasePath (String) - 保存元ブックのフォルダパス
' 戻り値: Boolean - 処理が成功した場合はTrue、スキップした場合はFalse
' 備考: シート名からフォルダ名とブック名を取得し、保存処理を行う
'-----------------------------------------
Dim strSheetName As String
Dim strFolderName As String
Dim strFolderPath As String
Dim strBookName As String
Dim wbNew As Workbook
On Error GoTo ErrorHandler
strSheetName = wsTarget.Name
' シート名からフォルダ名を取得
strFolderName = GetFolderNameFromSheetName(strSheetName)
' フォルダ名が取得できない（シート名に"_"がない）場合は処理をスキップ
If strFolderName = "" Then
ProcessSheet = False
Exit Function
End If
' ブック名はシート名と同一
strBookName = strSheetName
' 保存先フォルダのフルパスを生成
strFolderPath = strBasePath & Application.PathSeparator & strFolderName
' フォルダが存在しない場合は作成
Call CreateFolderIfNeeded(strFolderPath)
' シートを新しいブックにコピー
wsTarget.Copy
Set wbNew = ActiveWorkbook
' 新しいブックを名前を付けて保存
' DisplayAlertsがFalseなので、同名ファイルが存在する場合は確認なしで上書きされる
wbNew.SaveAs Filename:=strFolderPath & Application.PathSeparator & strBookName & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook
' 新しいブックを閉じる
wbNew.Close SaveChanges:=False
ProcessSheet = True ' 処理成功
CleanUp:
Set wbNew = Nothing
Exit Function
ErrorHandler:
' エラーが発生した場合、コピーして開いたブックが残らないように閉じる
If Not wbNew Is Nothing Then
wbNew.Close SaveChanges:=False
End If
' エラーを呼び出し元に伝播させる
Err.Raise Err.Number, "ProcessSheet", Err.Description
End Function
'--------------------------------------------------------------------------------
' ユーティリティプロシージャー
'--------------------------------------------------------------------------------
Private Function GetFolderNameFromSheetName(ByVal strSheetName As String) As String
'-----------------------------------------
' 機能: シート名からフォルダ名を取得する（"_"より前の部分）
' 引数: strSheetName (String) - 処理対象のシート名
' 戻り値: String - フォルダ名。"_"が見つからない場合は空文字を返す。
' 備考: InStr関数で"_"の位置を検索する
'-----------------------------------------
Dim lPos As Long
' シート名に含まれる最初の"_"の位置を探す
lPos = InStr(1, strSheetName, "_")
If lPos > 0 Then
' "_"が見つかった場合、その手前までをフォルダ名として返す
GetFolderNameFromSheetName = Left(strSheetName, lPos - 1)
Else
' "_"が見つからない場合は空文字を返す
GetFolderNameFromSheetName = ""
End If
End Function
Private Sub CreateFolderIfNeeded(ByVal strFolderPath As String)
'-----------------------------------------
' 機能: 指定されたパスにフォルダが存在しない場合に作成する
' 引数: strFolderPath (String) - 作成を確認するフォルダのフルパス
' 戻り値: なし
' 備考: Dir関数を使用してフォルダの存在をチェックする
'-----------------------------------------
On Error Resume Next ' MkDirでエラーが発生しても処理を継続させる（親フォルダがない等）
' Dir関数でフォルダの存在を確認
If Dir(strFolderPath, vbDirectory) = "" Then
' 存在しない場合はMkDirで作成
MkDir strFolderPath
' MkDirでエラーが発生した場合（例:書き込み権限がない）、エラーを発生させる
If Err.Number <> 0 Then
Err.Raise Err.Number, "CreateFolderIfNeeded", "フォルダの作成に失敗しました: " & strFolderPath
End If
End If
On Error GoTo 0
End Sub
Private Sub SetApplicationSettings(ByVal bEnable As Boolean)
'-----------------------------------------
' 機能: Excelアプリケーションの各種設定を一括で切り替える
' 引数: bEnable (Boolean) - Trueで通常設定、Falseで高速化設定
' 戻り値: なし
' 備考: 処理の最初と最後に呼び出す
'-----------------------------------------
Dim calcMode As Long
' bEnableの値に応じて計算モードを設定
If bEnable Then
calcMode = xlCalculationAutomatic
Else
calcMode = xlCalculationManual
End If
With Application
.ScreenUpdating = bEnable
.EnableEvents = bEnable
.DisplayAlerts = bEnable
.Calculation = calcMode
End With
End Sub
VBAコードの解説
1. コードの構成
このVBAコードは、保守性と可読性を高めるために、機能ごとに複数のプロシージャーに分割されています。
| プロシージャー名 | 種類 | 役割 |
| SplitSheetsToIndividualBooks | Public Sub | メイン処理。全体の流れを制御し、高速化設定やエラーハンドリングを行います。 |
| ProcessSheet | Private Function | 1枚のシートを受け取り、個別のブックとして保存する一連の処理を実行します。 |
| GetFolderNameFromSheetName | Private Function | シート名から保存先フォルダ名（"_"より前の文字列）を抽出するユーティリティです。 |
| CreateFolderIfNeeded | Private Sub | 指定されたパスにフォルダが存在しない場合に、新しいフォルダを作成するユーティリティです。 |
| SetApplicationSettings | Private Sub | 処理の高速化と安定化のため、Excelのアプリケーション設定を一時的に変更するユーティリティです。 |
2. 実行方法
- Excelで Alt + F11 を押してVBE（Visual Basic Editor）を開きます。
- 「挿入」メニューから「標準モジュール」を選択します。
- 表示されたコードウィンドウに、上記のVBAコードをすべてコピー＆ペーストします。
- Alt + F8 を押してマクロ一覧ダイアログを開き、「SplitSheetsToIndividualBooks」を選択して「実行」ボタンを押します。
3. 主な機能と設計
- 処理対象:
マクロを実行したExcelブック（ThisWorkbook）に含まれる全てのシートを対象とします。 - フォルダ・ファイルの自動生成:
- シート名が 部署1_日本 太郎 の場合、まずマクロブックと同じ階層に 部署1 という名前のフォルダを自動で作成します（既に存在する場合は何もしません）。
- 次に、その 部署1 フォルダの中に 部署1_日本 太郎.xlsx という名前で新しいブックを保存します。
- 再実行への対応:
- 保存先に同名のフォルダやファイルが既に存在する場合でもエラーにはなりません。
- フォルダはそのまま利用され、ファイルは確認メッセージなしで上書き保存されます。これは Application.DisplayAlerts = False の設定によるものです。
- 堅牢なエラーハンドリング:
- 処理を開始する前に、ブックが一度も保存されていない状態（パスが存在しない）かどうかをチェックし、未保存の場合は処理を安全に中断します。
- 処理中に万が一予期せぬエラーが発生した場合は、実行中の処理を停止し、エラー内容をメッセージボックスに表示します。また、Excelの設定を元に戻してから処理を終了するため、Excelが不安定な状態になるのを防ぎます。
- 高速化処理:
処理の開始時に画面描画やイベント、自動計算などを一時的に停止し、処理の終了時に元の設定に復元します。これにより、シート数が多い場合でも快適に処理を実行できます。 - 処理対象外シートのスキップ:
シート名に _（アンダースコア）が含まれていないシートは、命名規則に合わないものと判断し、処理をスキップします。最終的に、保存した件数とスキップした件数がメッセージで表示されます。
筆者のコメント
特にありません。完璧です。
ChatGPTの回答
以下はご依頼の要件に基づいて作成した業務品質レベルのExcel VBAコードです。シート名に基づき、「部署名」ごとにフォルダを作成し、各シートを個別ブックにエクスポートする堅牢で再実行可能な処理です。
VBAコード（モジュールに貼り付けてください）
コード解説
Option Explicit
'-----------------------------------------
' 機能: 個人別シートを部署別フォルダに個別ブックとして保存する
' 引数: なし
' 戻り値: なし
' 備考: シート名は「部署_氏名」形式を前提
'-----------------------------------------
Sub ExportSheetsToDepartmentFolders()
On Error GoTo ErrorHandler
Call InitializeApplicationSettings(False)
Dim wbSource As Workbook
Set wbSource = ThisWorkbook ' 任意のブックに適用する場合はここを変更
Dim ws As Worksheet
For Each ws In wbSource.Worksheets
If InStr(ws.Name, "_") > 0 Then
Call ExportSheetToWorkbook(ws, wbSource.Path)
End If
Next ws
Cleanup:
Call InitializeApplicationSettings(True)
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました: " & vbCrLf & _
"番号: " & Err.Number & vbCrLf & _
"内容: " & Err.Description, vbCritical, "エラー"
Resume Cleanup
End Sub
'-----------------------------------------
' 機能: Excelのアプリケーション設定を高速化・復元
' 引数: isRestore (Boolean) - Trueで元に戻す、Falseで高速化設定
' 戻り値: なし
' 備考: 呼び出し元で必ずペアで使うこと
'-----------------------------------------
Private Sub InitializeApplicationSettings(ByVal isRestore As Boolean)
With Application
If isRestore Then
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.DisplayAlerts = True
Else
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
.DisplayAlerts = False
End If
End With
End Sub
'-----------------------------------------
' 機能: 指定されたシートを部署別フォルダに個別保存
' 引数: wsTarget (Worksheet) - 対象シート
' strBasePath (String) - ベース出力フォルダパス
' 戻り値: なし
' 備考: 既に同名ファイルがある場合は上書き
'-----------------------------------------
Private Sub ExportSheetToWorkbook(ByVal wsTarget As Worksheet, ByVal strBasePath As String)
On Error GoTo ErrorHandler
Dim arrNameParts() As String
arrNameParts = Split(wsTarget.Name, "_")
If UBound(arrNameParts) <> 1 Then Exit Sub
Dim strDepartment As String
Dim strEmployee As String
strDepartment = Trim(arrNameParts(0))
strEmployee = Trim(arrNameParts(1))
Dim strDeptFolder As String
strDeptFolder = strBasePath & "\" & strDepartment
Call CreateFolderIfNotExist(strDeptFolder)
Dim strNewBookPath As String
strNewBookPath = strDeptFolder & "\" & wsTarget.Name & ".xlsx"
' ワークブックにコピーして保存
wsTarget.Copy
With ActiveWorkbook
.SaveAs Filename:=strNewBookPath, FileFormat:=xlOpenXMLWorkbook
.Close SaveChanges:=False
End With
Exit Sub
ErrorHandler:
MsgBox "エクスポートエラー: " & wsTarget.Name & vbCrLf & _
"番号: " & Err.Number & vbCrLf & _
"内容: " & Err.Description, vbExclamation, "シート保存失敗"
End Sub
'-----------------------------------------
' 機能: 指定フォルダが存在しなければ作成する
' 引数: strFolderPath (String) - 作成対象のフォルダパス
' 戻り値: なし
' 備考: 存在確認と作成を安全に実行
'-----------------------------------------
Private Sub CreateFolderIfNotExist(ByVal strFolderPath As String)
If Dir(strFolderPath, vbDirectory) = vbNullString Then
MkDir strFolderPath
End If
End Sub
コード解説
| 要素 | 説明 |
| ExportSheetsToDepartmentFolders | メインプロシージャー。すべてのシートを確認し、条件に合うものを処理します。 |
| InitializeApplicationSettings | 高速化と元の設定復元を切り替える共通処理です。再実行にも対応しています。 |
| ExportSheetToWorkbook | 指定シートを新しいワークブックとして保存。部署名に応じたフォルダ作成と保存までを担います。 |
| CreateFolderIfNotExist | フォルダが存在しない場合のみ MkDir で作成。再実行時も安全です。 |
| フォーマット | .xlsx（xlOpenXMLWorkbook）で保存し、互換性とデータ保持性を担保しています。 |
実行上の注意
- ThisWorkbook を ActiveWorkbook に変えることで、任意の開いているブックに対応可能です。
- シート名が _ を含まないものは無視されます。
- 上書き保存される仕様のため、必要であれば事前にバックアップを取ってください。
筆者のコメント
特にありません。完璧です。
Claudeの回答
個人別シートを部署別フォルダに分けて保存するVBAコードを作成いたします。
VBAコードの解説
Option Explicit
'-----------------------------------------
' 機能: メイン処理 - 個人別シートを部署別フォルダに分けて保存
' 引数: なし
' 戻り値: なし
' 備考: 高速化設定とエラーハンドリングを含む
'-----------------------------------------
Sub Main()
Dim blnScreenUpdating As Boolean
Dim xlCalculation As XlCalculation
Dim blnEnableEvents As Boolean
Dim blnDisplayAlerts As Boolean
' 現在の設定を保存
blnScreenUpdating = Application.ScreenUpdating
xlCalculation = Application.Calculation
blnEnableEvents = Application.EnableEvents
blnDisplayAlerts = Application.DisplayAlerts
On Error GoTo ErrorHandler
' 高速化設定
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False
' メイン処理実行
ProcessSheetSplitting
MsgBox "処理が完了しました。", vbInformation, "完了"
ExitHandler:
' 設定を元に戻す
Application.ScreenUpdating = blnScreenUpdating
Application.Calculation = xlCalculation
Application.EnableEvents = blnEnableEvents
Application.DisplayAlerts = blnDisplayAlerts
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました：" & vbCrLf & _
"エラー番号: " & Err.Number & vbCrLf & _
"エラー内容: " & Err.Description, vbCritical, "エラー"
GoTo ExitHandler
End Sub
'-----------------------------------------
' 機能: シート分割処理のメイン制御
' 引数: なし
' 戻り値: なし
' 備考: 対象シートの抽出と処理実行を制御
'-----------------------------------------
Private Sub ProcessSheetSplitting()
Dim wbSource As Workbook
Dim wsTarget As Worksheet
Dim strBasePath As String
Dim colTargetSheets As Collection
Dim varSheet As Variant
' 現在のブックを対象とする
Set wbSource = ActiveWorkbook
strBasePath = wbSource.Path
' 対象シートを収集
Set colTargetSheets = GetTargetSheets(wbSource)
If colTargetSheets.Count = 0 Then
MsgBox "対象となるシート（部署_氏名形式）が見つかりません。", vbExclamation, "警告"
Exit Sub
End If
' 各シートを処理
For Each varSheet In colTargetSheets
Set wsTarget = varSheet
ProcessIndividualSheet wsTarget, strBasePath
Next varSheet
End Sub
'-----------------------------------------
' 機能: 対象シートの抽出
' 引数: wbSource (Workbook) - 対象ブック
' 戻り値: Collection - 対象シートのコレクション
' 備考: 部署_氏名形式のシート名を持つシートを抽出
'-----------------------------------------
Private Function GetTargetSheets(ByRef wbSource As Workbook) As Collection
Dim colResult As Collection
Dim wsSheet As Worksheet
Dim strSheetName As String
Set colResult = New Collection
For Each wsSheet In wbSource.Worksheets
strSheetName = wsSheet.Name
' アンダースコアが含まれているかチェック（部署_氏名形式）
If InStr(strSheetName, "_") > 0 Then
colResult.Add wsSheet
End If
Next wsSheet
Set GetTargetSheets = colResult
End Function
'-----------------------------------------
' 機能: 個別シートの処理
' 引数: wsTarget (Worksheet) - 対象シート
' strBasePath (String) - ベースフォルダパス
' 戻り値: なし
' 備考: シートを新しいブックにコピーして保存
'-----------------------------------------
Private Sub ProcessIndividualSheet(ByRef wsTarget As Worksheet, ByRef strBasePath As String)
Dim strSheetName As String
Dim strDepartment As String
Dim strDepartmentPath As String
Dim strFileName As String
Dim strFullPath As String
Dim wbNew As Workbook
On Error GoTo ErrorHandler
strSheetName = wsTarget.Name
' 部署名を抽出
strDepartment = ExtractDepartmentName(strSheetName)
If strDepartment = "" Then
Exit Sub ' 部署名が取得できない場合はスキップ
End If
' フォルダパスとファイルパスを作成
strDepartmentPath = strBasePath & "\" & strDepartment
strFileName = strSheetName & ".xlsx"
strFullPath = strDepartmentPath & "\" & strFileName
' 部署フォルダを作成
CreateDirectoryIfNotExists strDepartmentPath
' 既存ファイルが存在する場合は削除（再実行対応）
DeleteFileIfExists strFullPath
' 新しいブックを作成してシートをコピー
Set wbNew = Workbooks.Add
wsTarget.Copy Before:=wbNew.Worksheets(1)
' 元の空白シートを削除
wbNew.Worksheets("Sheet1").Delete
' ファイルを保存
wbNew.SaveAs Filename:=strFullPath, FileFormat:=xlOpenXMLWorkbook
wbNew.Close SaveChanges:=False
Exit Sub
ErrorHandler:
If Not wbNew Is Nothing Then
wbNew.Close SaveChanges:=False
End If
Err.Raise Err.Number, "ProcessIndividualSheet", _
"シート「" & strSheetName & "」の処理中にエラーが発生しました：" & Err.Description
End Sub
'-----------------------------------------
' 機能: シート名から部署名を抽出
' 引数: strSheetName (String) - シート名
' 戻り値: String - 部署名
' 備考: 最初のアンダースコアまでを部署名として抽出
'-----------------------------------------
Private Function ExtractDepartmentName(ByRef strSheetName As String) As String
Dim intUnderscorePos As Integer
intUnderscorePos = InStr(strSheetName, "_")
If intUnderscorePos > 0 Then
ExtractDepartmentName = Left(strSheetName, intUnderscorePos - 1)
Else
ExtractDepartmentName = ""
End If
End Function
'-----------------------------------------
' 機能: フォルダが存在しない場合に作成
' 引数: strPath (String) - フォルダパス
' 戻り値: なし
' 備考: 既存の場合は何もしない
'-----------------------------------------
Private Sub CreateDirectoryIfNotExists(ByRef strPath As String)
Dim objFileSystem As Object
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
If Not objFileSystem.FolderExists(strPath) Then
objFileSystem.CreateFolder strPath
End If
End Sub
'-----------------------------------------
' 機能: ファイルが存在する場合に削除
' 引数: strFilePath (String) - ファイルパス
' 戻り値: なし
' 備考: 再実行時の重複回避
'-----------------------------------------
Private Sub DeleteFileIfExists(ByRef strFilePath As String)
Dim objFileSystem As Object
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
If objFileSystem.FileExists(strFilePath) Then
objFileSystem.DeleteFile strFilePath
End If
End Sub
VBAコードの解説
このVBAコードは、個人別のシートを部署別のフォルダに分けて保存する機能を提供します。以下の特徴があります：
主要機能
- シート名解析: "部署_氏名" 形式のシート名を解析し、部署名を抽出
- フォルダ作成: 部署名でフォルダを自動作成
- ファイル保存: 各シートを個別のExcelブック（.xlsx）として保存
- 再実行対応: 既存ファイルを自動削除して上書き保存
処理フロー
- Main(): 高速化設定とエラーハンドリングを行うメインプロシージャー
- ProcessSheetSplitting(): 対象シートを特定し、処理を制御
- GetTargetSheets(): アンダースコア（_）を含むシート名を持つシートを抽出
- ProcessIndividualSheet(): 個別シートの処理（コピー、保存）
- ExtractDepartmentName(): シート名から部署名を抽出
- ユーティリティ関数: フォルダ作成、ファイル削除
使用例
- シート名: "部署1_日本 太郎" → フォルダ: "部署1"、ファイル名: "部署1_日本 太郎.xlsx"
- シート名: "営業部_田中 花子" → フォルダ: "営業部"、ファイル名: "営業部_田中 花子.xlsx"
注意点
- 現在アクティブなブックが対象となります
- ブックと同じフォルダに部署フォルダが作成されます
- アンダースコア（_）を含まないシート名は処理対象外となります
- 既存ファイルは自動的に上書きされます（再実行対応）
実行するには、VBAエディタで上記コードを標準モジュールに貼り付け、Main()プロシージャーを実行してください。
筆者のコメント
特にありません。完璧です。
同じテーマ「生成AI活用研究」の記事
Geminiと100本ノック 18本目：名前定義の削除
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本目：シートをブックに分割
新着記事NEW ・・・新着記事一覧を見る
エクセル関数辞典 AI版｜エクセル入門（6月10日）
生成AIと100本ノック 28本目：シートをブックに分割｜生成AI活用研究（6月8日）
生成AIと脱Excelの時代：ブラックボックスと共に進む知的変革｜生成AI活用研究(2025-06-08)
生成AIと100本ノック 27本目：ハイパーリンクのURL｜生成AI活用研究（6月7日）
生成AIと100本ノック 26本目：ファイル一覧作成｜生成AI活用研究（6月6日）
AI時代のプログラミング再考：記述の自由と知の民主化｜生成AI活用研究(2025-06-06)
Excel×スプレッドシート連携：HTTP GETで学ぶGAS API設計入門｜生成AI活用研究(2025-06-04)
AI×ひらめき ― 「ネタ」が飛躍する創造の増幅プロセス｜生成AI活用研究(2025-06-03)
Googleカレンダーの日本の祝日をGASとExcelで取得する ～APIキー不要、XML連携ガイド～｜生成AI活用研究(2025-06-02)
究極のVBA転記プロンプト公開！あなたの事務作業を劇的に効率化｜生成AI活用研究(2025-06-02)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.変数宣言のDimとデータ型｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.FILTER関数（範囲をフィルター処理）｜エクセル入門
7.メッセージボックス(MsgBox関数)｜VBA入門
8.セルのクリア（Clear,ClearContents）｜VBA入門
9.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
10.マクロとは？VBAとは？VBAでできること｜VBA入門
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。