'Microsoft Scripting Runtimeにチェックを入れる→FileSystemObjectを使用する為
'Microsoft ActiveX Data Objects x.x にチェックを入れる→ADODB.Streamを使用する為
Public Sub CSVファイルをdataシートへ全て書き出し()
Dim fs As New Scripting.FileSystemObject
Dim files As Scripting.files
Dim file As Scripting.file
Dim strLine As String
Dim sData As String
Dim SPcsvData As Variant
Dim path As String
Dim fName As String
Dim cnt As Long
Dim ar() As Variant
Dim c As Long
'utf-8(BOM有) csvファイルの文字化け対策用
Dim ado_stream As New ADODB.Stream
'CSVファイルは、BusinessReportフォルダの中へ保存しておく
path = ThisWorkbook.path & "\BusinessReport"
Set files = fs.GetFolder(path).files
cnt = 0 '配列で使用するカウント用
For Each file In files
'utf-8 csv文字化け対策
With ado_stream
.Charset = "utf-8"
.LineSeparator = 10 '改行されなかったので設定変更
.Open
.LoadFromFile (file)
fName = Right(fs.GetBaseName(file), 8) 'ファイル名の日付部分のみを取得、この先の配列0に入れる
ado_stream.SkipLine '1行目(タイトル行)は読まない
'CSVファイルを2行目から1行づつ読み、ar配列へ格納
Do Until .EOS
strLine = .ReadText(adReadLine) '一行読む
sData = replaceColon(strLine) '\3,000のカンマも区切りと判断される為、区切りのカンマだけ:に置換
SPcsvData = Split(sData, ":")
ReDim Preserve ar(12, cnt)
ar(0, cnt) = fName 'ファイル名から取得した日付を配列に格納
'CSVの中の12項目も配列に格納
For c = LBound(SPcsvData) To UBound(SPcsvData)
ReDim Preserve ar(12, cnt)
ar(c + 1, cnt) = Mid(SPcsvData(c), 2, Len(SPcsvData(c)) - 2) 'データが""で囲われているので除去
Next
cnt = cnt + 1
Loop
.Close 'ファイルを閉じる
End With
Next
'何かデータが入っていた時の為に、一度セルのデータを消去
Worksheets("data").Range("A1").CurrentRegion.ClearContents
'読み込んだCSVファイルのデータを一気に書き出し
Worksheets("data").Range("A1").Resize(UBound(ar, 2) + 1, UBound(ar, 1) + 1).Value = _
Application.WorksheetFunction.Transpose(ar) 'Excel関数で行列入替
Set file = Nothing
Set files = Nothing
Set fs = Nothing
End Sub
Function replaceColon(str As String) As String
Dim strTemp As String
Dim quotCount As Long
Dim L As Long
For L = 1 To Len(str)
strTemp = Mid(str, L, 1) '1文字づつ調べる
If strTemp = """" Then 'ダブルコーテーション(")を単なる記号として扱いたいときは「""」と2つ続けて書く。
quotCount = quotCount + 1
ElseIf strTemp = "," Then
If quotCount Mod 2 = 0 Then
str = Left(str, L - 1) & ":" & Right(str, Len(str) - L)
End If
End If
Next
replaceColon = str
End Function
'Microsoft Scripting Runtimeにチェックを入れる→FileSystemObjectを使用する為
'Microsoft ActiveX Data Objects x.x にチェックを入れる→ADODB.Streamを使用する為
Public Sub CSVファイルをdataシートへ全て書き出し_Tanaka()
'以下の改良を行った by Tanaka
' [1]フォルダをユーザーに選択させる
' [2]選択したフォルダの中にCSVファイル以外が含まれる場合は実行中止
Dim fs As New Scripting.FileSystemObject
Dim files As Scripting.files
Dim file As Scripting.file
Dim strLine As String
Dim sData As String
Dim SPcsvData As Variant
' Dim path As String
Dim fName As String
Dim cnt As Long
Dim ar() As Variant
Dim c As Long
'utf-8(BOM有) csvファイルの文字化け対策用
Dim ado_stream As New ADODB.Stream
MsgBox "CSVファイルが保存されているフォルダを選択してください。"
'[1]FileDialogオブジェクトを使う方法
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
Set files = fs.GetFolder(.SelectedItems(1)).files
Else
Exit Sub
End If
End With
'[2]ファイル拡張子でcsvを判定
For Each file In files
If LCase(fs.GetExtensionName(file)) <> "csv" Then
MsgBox "CSVファイル以外のファイルが含まれるため実行できません。"
Exit Sub
End If
Next
'CSVファイルは、BusinessReportフォルダの中へ保存しておく
'path = ThisWorkbook.path & "\BusinessReport"
'Set files = fs.GetFolder(path).files
cnt = 0 '配列で使用するカウント用
For Each file In files
'utf-8 csv文字化け対策
With ado_stream
.Charset = "utf-8"
.LineSeparator = 10 '改行されなかったので設定変更
.Open
.LoadFromFile (file)
fName = Right(fs.GetBaseName(file), 8) 'ファイル名の日付部分のみを取得、この先の配列0に入れる
ado_stream.SkipLine '1行目(タイトル行)は読まない
'CSVファイルを2行目から1行づつ読み、ar配列へ格納
Do Until .EOS
strLine = .ReadText(adReadLine) '一行読む
sData = replaceColon(strLine) '\3,000のカンマも区切りと判断される為、区切りのカンマだけ:に置換
SPcsvData = Split(sData, ":")
ReDim Preserve ar(12, cnt)
ar(0, cnt) = fName 'ファイル名から取得した日付を配列に格納
'CSVの中の12項目も配列に格納
For c = LBound(SPcsvData) To UBound(SPcsvData)
ReDim Preserve ar(12, cnt)
ar(c + 1, cnt) = Mid(SPcsvData(c), 2, Len(SPcsvData(c)) - 2) 'データが""で囲われているので除去
Next
cnt = cnt + 1
Loop
.Close 'ファイルを閉じる
End With
Next
'何かデータが入っていた時の為に、一度セルのデータを消去
Worksheets("data").Range("A1").CurrentRegion.ClearContents
'読み込んだCSVファイルのデータを一気に書き出し
Worksheets("data").Range("A1").Resize(UBound(ar, 2) + 1, UBound(ar, 1) + 1).Value = _
Application.WorksheetFunction.Transpose(ar) 'Excel関数で行列入替
Set file = Nothing
Set files = Nothing
Set fs = Nothing
End Sub
たかちゃんさんの投稿
(投稿ID: 4992)
・csv内には日付データがない為、ファイル名から日付を取得
・csv内の12項目&日付を配列に入れ、一気にシートに書き出し
csvファイルはこのような感じです。
"ABC1230","掃除機","\6,000"...
EmEditorで確認した所、utf-8(BOM有)
苦労した点
・金額の,が区切り文字と判断される
→replaceColonという関数を作成し、区切りのカンマのみ
":"(コロン)に置き換えた
・データを配列に入れ、エクセルに書き出すと文字化け
→FileSystemObjectの代わりに、ADODB.streamを使用して
CSVを読ませた
・CSV内の改行が認識されなかった
→ADODB.streamのLineSeparatorの値をデフォルトから変更
ほぼ丸一日かかって書き上げ、動いた時は非常に嬉しかった為
記念投稿します。
とても長いのでコメントは気になさらないで下さい(^^)
今度は、データを使用しどのように分析する為のグラフを作ろう・・
と考えてます。ここはVBAと関係ありませんが、。
マクロは奥が深いです。
【参考URL】
https://tonari-it.com/vba-csv-camma/
https://tonari-it.com/vba-csv-utf8/
田中 宏明さんのコメント
(コメントID: 7108)
> 複数のCSVファイルを自動で読み込ませるマクロを書いてみました。
>
> とても長いのでコメントは気になさらないで下さい(^^)
お疲れさまです。
CSVファイルを正確にExcelへ取り込む場合、落とし穴がたくさんありそうですね。
汎用性を高めるため、フォルダをユーザーに選択させる改良を行ってみました。
小川慶一さんのコメント
(コメントID: 7110)
エクセル標準機能のファイルの読み込みウィザードは試されましたでしょうか。
リボンの[データ]→[データの取得」や[テキストまたはCSVから]です。
自動記録をしつつこれらを使ってファイルを読み込みます。文字コードやCSVの書式の問題はある程度解決してくれます。
あとは、ベタに、 workbooks.open(some_csv_path) と、CSVファイルをエクセルファイルのように開いてしまう。
「これでちゃんと動けば儲けもの」ということで。
小川慶一さんのコメント
(コメントID: 7114)
おはようございます。
手段の引き出しが多いのはとても良いかと (^^
ひきつづき、よい学びを☆