今回は 「統合時にファイル名＋タイムスタンプを同時に追加する版」 と 「列名を動的に指定できる汎用版」 を紹介します。
1. 統合時にファイル名＋タイムスタンプを同時に追加する版
CSVを統合するときに、元ファイル名と処理日時 を列として追加しておくと、後から「どのファイル由来でいつ統合したか」が追跡できます。
Sub MergeCSV_AddFileAndTimestamp()
Dim folderPath As String, fileName As String
Dim wsMaster As Worksheet
Dim pasteRow As Long, lastRow As Long
Dim ts As String
folderPath = "C:\Data\CSV\" ' ←環境に合わせて変更
Set wsMaster = ThisWorkbook.Sheets("Master")
wsMaster.Cells.Clear
pasteRow = 1
ts = Format(Now, "yyyy-mm-dd HH:NN:SS") ' 現在日時
fileName = Dir(folderPath & "*.csv")
Do While fileName <> ""
Dim wbCSV As Workbook, wsCSV As Worksheet
Set wbCSV = Workbooks.Open(folderPath & fileName)
Set wsCSV = wbCSV.Sheets(1)
lastRow = wsCSV.Cells(wsCSV.Rows.Count, 1).End(xlUp).Row
' データコピー
wsCSV.Range("A1:A" & lastRow).EntireRow.Copy wsMaster.Cells(pasteRow, 1)
' ファイル名とタイムスタンプ列を追加
Dim copiedRows As Long, lastCol As Long
copiedRows = lastRow
lastCol = wsMaster.Cells(pasteRow, wsMaster.Columns.Count).End(xlToLeft).Column + 1
wsMaster.Range(wsMaster.Cells(pasteRow, lastCol), wsMaster.Cells(pasteRow + copiedRows - 1, lastCol)).Value = fileName
wsMaster.Range(wsMaster.Cells(pasteRow, lastCol + 1), wsMaster.Cells(pasteRow + copiedRows - 1, lastCol + 1)).Value = ts
pasteRow = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1
wbCSV.Close SaveChanges:=False
fileName = Dir
Loop
MsgBox "CSV統合完了！（ファイル名＋タイムスタンプ列付き）"
End Sub
2. 列名を動的に指定できる汎用版
必要な列名を指定して、その列だけを統合する汎用的なテンプレートです。
※ 各CSVの1行目をヘッダ行として扱い、列名を検索してコピーします。
Sub MergeCSV_DynamicColumns()
Dim folderPath As String, fileName As String
Dim wsMaster As Worksheet
Dim pasteRow As Long, lastRow As Long
Dim targetCols As Variant
Dim i As Long
' 抽出したい列名を配列で指定
targetCols = Array("ID", "Value", "Date")
folderPath = "C:\Data\CSV\" ' ←環境に合わせて変更
Set wsMaster = ThisWorkbook.Sheets("Master")
wsMaster.Cells.Clear
pasteRow = 1
fileName = Dir(folderPath & "*.csv")
Do While fileName <> ""
Dim wbCSV As Workbook, wsCSV As Worksheet
Set wbCSV = Workbooks.Open(folderPath & fileName)
Set wsCSV = wbCSV.Sheets(1)
lastRow = wsCSV.Cells(wsCSV.Rows.Count, 1).End(xlUp).Row
' ヘッダ行から列位置を検索
Dim colIndex() As Long
ReDim colIndex(LBound(targetCols) To UBound(targetCols))
For i = LBound(targetCols) To UBound(targetCols)
colIndex(i) = Application.Match(targetCols(i), wsCSV.Rows(1), 0)
Next i
' ヘッダ行をコピー（最初のファイルのみ）
If pasteRow = 1 Then
For i = LBound(targetCols) To UBound(targetCols)
wsMaster.Cells(1, i + 1).Value = targetCols(i)
Next i
pasteRow = 2
End If
' データ行をコピー
Dim r As Long
For r = 2 To lastRow
For i = LBound(targetCols) To UBound(targetCols)
wsMaster.Cells(pasteRow, i + 1).Value = wsCSV.Cells(r, colIndex(i)).Value
Next i
pasteRow = pasteRow + 1
Next r
wbCSV.Close SaveChanges:=False
fileName = Dir
Loop
MsgBox "CSV統合完了！（指定列のみ抽出）"
End Sub
✅ まとめ
- ファイル名＋タイムスタンプ追加版 → データの出所と処理日時を追跡可能。
- 列名動的指定版 → 必要な列だけを柔軟に抽出できる汎用設計。
