🐕
[ChatGPT]複数のExcelブックから特定のシートを1ブックにをマージするコード書かせてみた
概要
ChatGPTが進化を遂げている(応答精度が高くなってる)のをひしひし感じてきたので、簡単なツール作ってもらう投稿です
作るもの
- 複数のExcelブックから特定のシートを1ブックにをマージするExcelマクロツール
プロンプト
- 何回かキャッチボールしてます..
あなたはシニアVBAプログラマです。
私は、VBAで複数のエクセルブックの中にある、特定の名前のシートを１つのエクセルブックにマージするツールを作りたいと思っています。
要件をお伝えするのでソースコードを書いてくれませんか？
## ファイル
①エクセルマクロブック「merge_excelbook.xlsm」
## 前提条件
①にはシート「index」があります。
## 処理フロー
- ①内の関数「collectTargetSheet」
- マージ対象のエクセルファイルを選択させるダイヤログを表示させます
- 拡張子は「.xlsx」「.xls」に絞らせます
- ファイルは複数選択することが可能です
- 選択したファイルを順番に繰り返し処理します
- ファイル内のシート名を、①のシート「index」に転記する
- ①シート「index」のA2にファイル名を転記
- ①シート「index」のB2にファイルのフルパスを転記
- ①シート「index」のC2にシート名を転記
- ①シート「index」のC2にプルダウンで「◯」「ー」が選択できるようにする
- ①内の関数「merge」
- 新しいワークブック(T)を作成する
- ①シート「index」の[C2]が「◯」の場合、セル[B3]から下方向に記載されているファイルのフルパス情報を順番に読み込みます
- 読み込んだファイルのフルパスを開く
- 同じ行のセル[C]に記載されているシートをワークブック(T)にコピーする
以上です。
これらの処理を書いて下さい。
アウトプット
Option Explicit
Sub collectTargetSheet()
Dim fd As FileDialog
Dim FileChosen As Boolean
Dim FilePath As Variant
Dim wb As Workbook
Dim wsIndex As Worksheet
Dim ws As Worksheet
Dim NextRow As Long
' シート「index」を取得
Set wsIndex = ThisWorkbook.Sheets("index")
' 「index」シートをクリア
wsIndex.Cells.Clear
' ヘッダーを追加
wsIndex.Range("A1").Value = "ファイル名"
wsIndex.Range("B1").Value = "フルパス"
wsIndex.Range("C1").Value = "シート名"
wsIndex.Range("D1").Value = "選択"
' ファイルダイアログを作成
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "マージ対象のエクセルファイルを選択してください"
fd.Filters.Clear
fd.Filters.Add "Excel Files", "*.xls; *.xlsx"
fd.AllowMultiSelect = True
FileChosen = fd.Show
If FileChosen Then
NextRow = 2 ' データの書き込み開始行
For Each FilePath In fd.SelectedItems
Set wb = Workbooks.Open(FilePath)
For Each ws In wb.Sheets
wsIndex.Cells(NextRow, 1).Value = wb.Name
wsIndex.Cells(NextRow, 2).Value = wb.FullName
wsIndex.Cells(NextRow, 3).Value = ws.Name
' プルダウンリストを追加
With wsIndex.Cells(NextRow, 4).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="◯,－"
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
NextRow = NextRow + 1
Next ws
wb.Close SaveChanges:=False
Next FilePath
Else
MsgBox "ファイルが選択されませんでした。", vbExclamation
End If
End Sub
Sub merge()
Dim wsIndex As Worksheet
Dim NewWorkbook As Workbook
Dim SourceWorkbook As Workbook
Dim SourceSheet As Worksheet
Dim i As Long
Dim LastRow As Long
Dim SourceFilePath As String
Dim SourceSheetName As String
' 新しいワークブックを作成
Set NewWorkbook = Workbooks.Add
' シート「index」を取得
Set wsIndex = ThisWorkbook.Sheets("index")
' 「index」シートの最終行を取得
LastRow = wsIndex.Cells(wsIndex.Rows.Count, 2).End(xlUp).Row
' 「index」シートの情報を基にシートをマージ
For i = 3 To LastRow
' プルダウンリストで「◯」が選択されているか確認
If wsIndex.Cells(i, 4).Value = "◯" Then
SourceFilePath = wsIndex.Cells(i, 2).Value
SourceSheetName = wsIndex.Cells(i, 3).Value
' ソースブックを開く
Set SourceWorkbook = Workbooks.Open(SourceFilePath)
' ソースシートをコピー
Set SourceSheet = SourceWorkbook.Sheets(SourceSheetName)
SourceSheet.Copy After:=NewWorkbook.Sheets(NewWorkbook.Sheets.Count)
' ソースブックを閉じる
SourceWorkbook.Close SaveChanges:=False
End If
Next i
MsgBox "シートのマージが完了しました！", vbInformation
End Sub
- シート「index」を作成したExcelマクロファイルにこちらのコードを貼り付けるだけでOK
成果物
- こちらにおいてます
所感
思った以上に正確に書いてくれました。
以上です。
Discussion