| |
▼YUKI さん：
ついでに（といっては何ですが）
ぼくが最初に考えていた処理の流れを紹介しておきます。
（CSVファイルの結合を行わず、個々のCSVファイルを指定シートに
順番に インポートしていく方法です）
'最初に考えていた方法
（仮定）各CSVファイルには 列見出しがあると考えています。
１つめのCSVをシートに書き出すときは、この列見出しを含めて
1行目から書き出します。
2つ目以降のCSVは 2行目からインポートしています。
Sub 複数CSVファイルのインポート()
Dim fs As Object, fd As FileDialog
Dim fStr As String, fName As Variant
Dim i As Long, fCount As Long
'結合するCSVファイルの選択
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Title = "データ選択（ファイル参照）"
.Filters.Add "CSVファイル", "*.csv"
If .Show = 0 Then Exit Sub
fCount = .SelectedItems.Count
If fCount < 2 Then
MsgBox "データを複数選んでください"
Exit Sub
End If
End With
'指定CSVを2枚目のシートにインポートする
Dim iRow As Long 'Importするシート行番号
Dim WS As Worksheet
Set WS = Worksheets.Add(After:=Worksheets(1))
For i = 1 To fCount
CSVのインポート fd.SelectedItems(i), WS, iRow
Next
'名前を付けてXLS形式で保存
fName = LCase$(fd.SelectedItems.Item(1))
fName = Replace(fName, ".csv", ".xls")
fName = Application.GetSaveAsFilename( _
InitialFileName:=fName, FileFilter:="Book,*.xls")
If fName = False Then Exit Sub
Application.EnableEvents = False
ActiveWorkbook.SaveAs fName, FileFormat:=xlNormal
Application.EnableEvents = True
End Sub
Sub CSVのインポート(CSVname, ByVal WS As Worksheet, iRow As Long)
iRow = iRow + 1
With WS
With .QueryTables.Add(Connection:= _
"TEXT;" & CSVname, Destination:=WS.Cells(iRow, 1))
.Name = "foo" 'iRow : Sheet書き出し行
.FieldNames = True
.AdjustColumnWidth = True
.TextFilePlatform = 932
.TextFileStartRow = 1 - (iRow > 1) 'Text Import開始行
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
WS.Names(.Name).Delete
.Delete
End With
iRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
End Sub
|
|
kanabun
- 09/9/29(火) 0:11 -
