さまざまなCSVを読み込み可能な
このマクロは、「CSVの読み込み方法(改)」を参考にしています。ありがとうございます。
csvデータの中に、改行が入っているデータも、正常に読み込むマクロを紹介します。
このプロシージャは、引数として、「csvファイル名」と「シート名」を指定すると、csvデータが、指定のシートに、読み込まれす。
使い方は、以下と同じです。
'*******
'* さまざまなCSVを読み込み可能。20230718
'* データ内に改行があっても対応可能
'* https://excel-ubara.com/excelvba5/EXCEL119.html
'* csvFile:csvファイル名、フルパス
'* csvSheetName:CSVファイルを読み込むシート名
'* FirstRange:先頭のRange
'* csvSheetNameFormat:ひな形になるシート名。これが設定されていない場合、新規作成
Sub csv_to_sheet_r1(ByVal csvFile As String, ByVal csvSheetName As String, Optional ByVal FirstRange As String = "A1", Optional csvSheetNameFormat As String = "")
Dim varFileName As Variant
Dim objFSO As New FileSystemObject
Dim inTS As TextStream
Dim strRec As String
Dim strSplit() As String
Dim i As Long, j As Long, k As Long
Dim lngQuote As Long
Dim strCell As String
Dim blnCrLf As Boolean
Dim Sheet As Worksheet
Dim csvSheet As Worksheet
'既にシート「csv」が存在する場合は削除
For Each Sheet In ThisWorkbook.Worksheets
If Sheet.Name = csvSheetName Then
'確認メッセージを非表示
Application.DisplayAlerts = False
'シート削除
Worksheets(csvSheetName).Delete
'確認メッセージを表示
Application.DisplayAlerts = True
End If
Next
If csvSheetNameFormat = "" Then
'シート「csv」を新規作成
Set csvSheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Else
'シート「csvSheetNameFormat」をコピー
Worksheets(csvSheetNameFormat).Copy after:=Worksheets(Worksheets.Count)
Set csvSheet = ActiveSheet
End If
' シート名指定
csvSheet.Name = csvSheetName
varFileName = csvFile
If varFileName = False Then
Exit Sub
End If
Set inTS = objFSO.OpenTextFile(CStr(varFileName), ForReading)
strRec = CStr(inTS.ReadAll)
'i = 1 'シートの1行目から出力
i = Range(FirstRange).Row
'j = 0 '列位置はPutCellでカウントアップ
Dim initial_j As Long
initial_j = Range(FirstRange).Column - 1
j = initial_j
lngQuote = 0 'ダブルクォーテーションの数
strCell = ""
For k = 1 To Len(strRec)
Select Case Mid(strRec, k, 1)
Case vbLf, vbCr '「"」が偶数なら改行、奇数ならただの文字
If lngQuote Mod 2 = 0 Then
blnCrLf = False
If k > 1 Then '改行としてのCrLfはCrで改行判定済なので無視する
If Mid(strRec, k - 1, 2) = vbCrLf Then
blnCrLf = True
End If
End If
If blnCrLf = False Then
Call PutCell(i, j, strCell, lngQuote, csvSheet)
i = i + 1
j = initial_j
lngQuote = 0
strCell = ""
End If
Else
strCell = strCell & Mid(strRec, k, 1)
End If
Case "," '「"」が偶数なら区切り、奇数ならただの文字
If lngQuote Mod 2 = 0 Then
Call PutCell(i, j, strCell, lngQuote, csvSheet)
Else
strCell = strCell & Mid(strRec, k, 1)
End If
Case """" '「"」のカウントをとる
lngQuote = lngQuote + 1
strCell = strCell & Mid(strRec, k, 1)
Case Else
strCell = strCell & Mid(strRec, k, 1)
End Select
Next
'最終列の処理
If j > 0 And strCell <> "" Then
Call PutCell(i, j, strCell, lngQuote, csvSheet)
End If
Set inTS = Nothing
Set objFSO = Nothing
End Sub
まず、元のcsvの紹介です。このcsvは、以下のように、データ内に改行が入っています。
これを、以下のマクロで読み込みます。
Sub テスト、csv_to_sheet()
Call csv_to_sheet(ThisWorkbook.Path & "\sample9.csv", "s11")
End Sub
結果は、以下です。
改行が影響して、正常に読み込めていません。
次に、ここで紹介したマクロを、以下通り、実行します。
Sub テスト、csv_to_sheet_r1()
Call csv_to_sheet_r1(ThisWorkbook.Path & "\sample9.csv", "s12")
End Sub
結果は、以下の通り、正常に読み込めました。csvのデータにより、工夫が必要になります。
“さまざまなCSVを読み込み可能な” に対して2件のコメントがあります。