Sub ImportAndFormatCSV()
Dim csvFiles As Variant
Dim i As Long
Dim tempWB As Workbook
Dim tempWS As Worksheet
Dim newWS As Worksheet
Dim fileName As String
Dim lastCol As Long, lastRow As Long
' ファイル選択
csvFiles = Application.GetOpenFilename("CSVファイル (*.csv),*.csv", _
Title:="CSVファイルを選択(複数可)", _
MultiSelect:=True)
If VarType(csvFiles) = vbBoolean Then Exit Sub
Application.ScreenUpdating = False
For i = LBound(csvFiles) To UBound(csvFiles)
' 一時的に開いてデータを取得
Set tempWB = Workbooks.Open(Filename:=csvFiles(i), ReadOnly:=True)
Set tempWS = tempWB.Sheets(1)
' 新しいシート作成
fileName = Mid(csvFiles(i), InStrRev(csvFiles(i), "\") + 1)
Set newWS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
newWS.Name = Left(fileName, 31)
' データコピー
tempWS.UsedRange.Copy Destination:=newWS.Range("A2")
tempWB.Close SaveChanges:=False
' 整形処理開始
With newWS
lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
' 1行目にヘッダー追加(仮名)
For c = 1 To lastCol
.Cells(1, c).Value = "項目" & c
.Cells(1, c).Font.Bold = True
.Cells(1, c).Interior.Color = RGB(200, 200, 255)
Next c
' 不要な列削除(例:4列目以降を削除)
If lastCol > 3 Then
.Range(.Cells(1, 4), .Cells(lastRow, lastCol)).Delete
End If
' 列幅自動調整
.Columns("A:Z").AutoFit
' 罫線を引く
.Range(.Cells(1, 1), .Cells(lastRow, 3)).Borders.LineStyle = xlContinuous
' センタリング
.Range(.Cells(1, 1), .Cells(lastRow, 3)).HorizontalAlignment = xlCenter
End With
Next i
Application.ScreenUpdating = True
MsgBox "CSV読み込みと整形が完了しました!", vbInformation
End Sub
コメント