CSVの読み込み方法（ジャグ配列）（改）
CSVのマクロVBAでの読込方法についての記事は、人気記事として多くのアクセスがあります。
順次改定していくつかのバージョンが存在します。
最新のジャグ配列（配列の配列）で読み込むVBAについて、UTF-8Nの文字コード判別の課題が残っていました。
そこで、いろいろなサイトを参考にして、これに対応するVBAを作成しました。
また、使うにあたって参照設定が面倒な場合もあるので、参照設定せずにCreateObjectに変更してコピペで使いやすくしています。
CSV読み込みVBAコード：CSVの読み込み方法（ジャグ配列）（改）
'CSVファイルを指定シートに出力
Public Sub CsvToSheet(ByVal ws As Worksheet, _
ByVal strFile As String, _
Optional ByVal CharSet As String = "Auto")
Dim myArray() As Variant
'readCsvでCSVを読み込み
Dim strRec As String
strRec = readCsv(strFile, CharSet)
'CsvToJaggedで行・フィールドに分割してジャグ配列に
Dim jagArray() As Variant
jagArray = CsvToJagged(strRec)
'JaggedTo2Dでジャグ配列を2次元配列に変換
Call JaggedTo2D(jagArray, myArray)
'上記を全てネストすれば以下で書けますが、お勧めはしません。
'Call JaggedTo2D(CsvToJagged(readCsv(strFile, CharSet)), myArray)
'2次元配列→シート
ws.Range("A1").Resize(UBound(myArray, 1), UBound(myArray, 2)) = myArray
End Sub
Private Sub JaggedTo2D(ByRef jagArray() As Variant, _
ByRef twoDArray As Variant)
'ジャグ配列の最大列数取得
Dim maxCol As Long, v As Variant
maxCol = 0
For Each v In jagArray
If UBound(v) > maxCol Then
maxCol = UBound(v)
End If
Next
'ジャグ配列→2次元配列
Dim i1 As Long, i2 As Long
ReDim twoDArray(1 To UBound(jagArray), 1 To maxCol)
For i1 = 1 To UBound(jagArray)
For i2 = 1 To UBound(jagArray(i1))
twoDArray(i1, i2) = jagArray(i1)(i2)
Next
Next
End Sub
Private Function CsvToJagged(ByVal strRec As String) As Variant()
Dim childArray() As Variant 'ジャグ配列の子配列
Dim lngQuate As Long 'ダブルクォーテーション数
Dim strCell As String '1フィールド文字列
Dim blnCrLf As Boolean '改行判定
Dim i As Long '行位置
Dim j As Long '列位置
Dim k As Long
ReDim CsvToJagged(1 To 1) 'ジャグ配列の初期化
ReDim childArray(1 To 1) 'ジャグ配列の子配列の初期化
i = 1 'シートの1行目から出力
j = 0 '列位置はputChildArrayでカウントアップ
lngQuate = 0 'ダブルクォーテーションの数
strCell = ""
For k = 1 To Len(strRec)
Select Case Mid(strRec, k, 1)
Case vbLf, vbCr '「"」が偶数なら改行、奇数ならただの文字
If lngQuate 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 putChildArray(childArray, j, strCell, lngQuate)
'これが改行となる
Call putjagArray(CsvToJagged, childArray, _
i, j, lngQuate, strCell)
End If
Else
strCell = strCell & Mid(strRec, k, 1)
End If
Case ",", vbTab '「"」が偶数なら区切り、奇数ならただの文字
If lngQuate Mod 2 = 0 Then
Call putChildArray(childArray, j, strCell, lngQuate)
Else
strCell = strCell & Mid(strRec, k, 1)
End If
Case """" '「"」のカウントをとる
lngQuate = lngQuate + 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 putChildArray(childArray, j, strCell, lngQuate)
Call putjagArray(CsvToJagged, childArray, _
i, j, lngQuate, strCell)
End If
End Function
Private Sub putjagArray(ByRef jagArray() As Variant, _
ByRef childArray() As Variant, _
ByRef i As Long, _
ByRef j As Long, _
ByRef lngQuate As Long, _
ByRef strCell As String)
If i > UBound(jagArray) Then '常に成立するが一応記述
ReDim Preserve jagArray(1 To i)
End If
jagArray(i) = childArray '子配列をジャグ配列に入れる
ReDim childArray(1 To 1) '子配列の初期化
i = i + 1 '列位置
j = 0 '列位置
lngQuate = 0 'ダブルクォーテーション数
strCell = "" '1フィールド文字列
End Sub
'1フィールドごとにセルに出力
Private Sub putChildArray(ByRef childArray() As Variant, _
ByRef j As Long, _
ByRef strCell As String, _
ByRef lngQuate As Long)
j = j + 1
'「""」を「"」で置換
strCell = Replace(strCell, """""", """")
'前後の「"」を削除
If Left(strCell, 1) = """" And Right(strCell, 1) = """" Then
If Len(strCell) <= 2 Then
strCell = ""
Else
strCell = Mid(strCell, 2, Len(strCell) - 2)
End If
End If
If j > UBound(childArray) Then
ReDim Preserve childArray(1 To j)
End If
childArray(j) = strCell
strCell = ""
lngQuate = 0
End Sub
'文字コードを自動判別し、全行をCrLf区切りに統一してStringに入れる
Private Function readCsv(ByVal strFile As String, _
ByVal CharSet As String) As String
' Dim objFSO As New FileSystemObject
' Dim inTS As TextStream
' Dim adoSt As New ADODB.Stream
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim inTS As Object
Dim adoSt As Object
Set adoSt = CreateObject("ADODB.Stream")
Dim strRec As String
Dim i As Long
Dim aryRec() As String
If CharSet = "Auto" Then CharSet = getCharSet(strFile)
Select Case UCase(CharSet)
Case "UTF-8", "UTF-8N"
'ADOを使って読込、その後の処理を統一するため全レコードをCrLfで結合
'Set inTS = objFSO.OpenTextFile(strFile, ForAppending)
Set inTS = objFSO.OpenTextFile(strFile, 8)
i = inTS.Line - 1
inTS.Close
ReDim aryRec(i)
With adoSt
'.Type = adTypeText
.Type = 2
.CharSet = "UTF-8"
.Open
.LoadFromFile strFile
i = 0
Do While Not (.EOS)
'aryRec(i) = .ReadText(adReadLine)
aryRec(i) = .ReadText(-2)
i = i + 1
Loop
.Close
strRec = Join(aryRec, vbCrLf)
End With
Case "UTF-16 LE", "UTF-16 BE"
'Set inTS = objFSO.OpenTextFile(strFile, , , TristateTrue)
Set inTS = objFSO.OpenTextFile(strFile, , , -1)
strRec = inTS.ReadAll
inTS.Close
Case "SHIFT-JIS"
Set inTS = objFSO.OpenTextFile(strFile)
strRec = inTS.ReadAll
inTS.Close
Case Else
'EUC-JP、UTF-32については未テスト
MsgBox "文字コードを確認してください。" & vbLf & CharSet
Stop
End Select
Set inTS = Nothing
Set objFSO = Nothing
readCsv = strRec
End Function
'文字コードの自動判別
Private Function getCharSet(strFileName As String) As String
Dim bytes() As Byte
Dim intFileNo As Integer
ReDim bytes(FileLen(strFileName))
intFileNo = FreeFile
Open strFileName For Binary As #intFileNo
Get #intFileNo, , bytes
Close intFileNo
'BOMによる判断
getCharSet = getCharFromBOM(bytes)
'BOMなしをデータの文字コードで判別
If getCharSet = "" Then
getCharSet = getCharFromCode(bytes)
End If
Debug.Print strFileName & " : " & getCharSet
End Function
'BOMによる判断
Private Function getCharFromBOM(ByRef bytes() As Byte) As String
getCharFromBOM = ""
If UBound(bytes) < 3 Then Exit Function
Select Case True
Case bytes(0) = &HEF And _
bytes(1) = &HBB And _
bytes(2) = &HBF
getCharFromBOM = "UTF-8"
Exit Function
Case bytes(0) = &HFF And _
bytes(1) = &HFE
If bytes(2) = &H0 And _
bytes(3) = &H0 Then
getCharFromBOM = "UTF-32 LE"
Exit Function
End If
getCharFromBOM = "UTF-16 LE"
Exit Function
Case bytes(0) = &HFE And _
bytes(1) = &HFF
getCharFromBOM = "UTF-16 BE"
Exit Function
Case bytes(0) = &H0 And _
bytes(1) = &H0 And _
bytes(2) = &HFE And _
bytes(3) = &HFF
getCharFromBOM = "UTF-32 BE"
Exit Function
End Select
End Function
'以下は下記サイトのコードをVBAに移植
'https://dobon.net/vb/dotnet/string/detectcode.html
'BOMなしをデータの文字コードで判別
Private Function getCharFromCode(ByRef bytes() As Byte) As String
Const bEscape As Byte = &H1B
Const bAt As Byte = &H40
Const bDollar As Byte = &H24
Const bAnd As Byte = &H26
Const bOpen As Byte = &H28
Const bB As Byte = &H42
Const bD As Byte = &H44
Const bJ As Byte = &H4A
Const bI As Byte = &H49
Dim bLen As Long: bLen = UBound(bytes)
Dim b1 As Byte, b2 As Byte, b3 As Byte, b4 As Byte
Dim isBinary As Boolean: isBinary = False
Dim i As Long
For i = 0 To bLen - 1
b1 = bytes(i)
If b1 <= &H6 Or b1 = &H7F Or b1 = &HFF Then
isBinary = True
If b1 = &H0 And i < bLen - 1 And bytes(i + 1) <= &H7F Then
getCharFromCode = "Shift_JIS"
Exit Function
End If
End If
Next
If isBinary Then
getCharFromCode = ""
Exit Function
End If
For i = 0 To bLen - 3
b1 = bytes(i)
b2 = bytes(i + 1)
b3 = bytes(i + 2)
If b1 = bEscape Then
If b2 = bDollar And b3 = bAt Then
getCharFromCode = "Shift_JIS"
Exit Function
ElseIf b2 = bDollar And b3 = bB Then
getCharFromCode = "Shift_JIS"
Exit Function
ElseIf b2 = bOpen And (b3 = bB Or b3 = bJ) Then
getCharFromCode = "Shift_JIS"
Exit Function
ElseIf b2 = bOpen And b3 = bI Then
getCharFromCode = "Shift_JIS"
Exit Function
End If
If i < bLen - 3 Then
b4 = bytes(i + 3)
If b2 = bDollar And b3 = bOpen And b4 = bD Then
getCharFromCode = "Shift_JIS"
Exit Function
End If
If i < bLen - 5 And _
b2 = bAnd And b3 = bAt And b4 = bEscape And _
bytes(i + 4) = bDollar And bytes(i + 5) = bB Then
getCharFromCode = "Shift_JIS"
Exit Function
End If
End If
End If
Next
Dim sjis As Long: sjis = 0
Dim euc As Long: euc = 0
Dim utf8 As Long: utf8 = 0
For i = 0 To bLen - 2
b1 = bytes(i)
b2 = bytes(i + 1)
If ((&H81 <= b1 And b1 <= &H9F) Or (&HE0 <= b1 And b1 <= &HFC)) And _
((&H40 <= b2 And b2 <= &H7E) Or (&H80 <= b2 And b2 <= &HFC)) Then
sjis = sjis + 2
i = i + 1
End If
Next
For i = 0 To bLen - 2
b1 = bytes(i)
b2 = bytes(i + 1)
If ((&HA1 <= b1 And b1 <= &HFE) And _
(&HA1 <= b2 And b2 <= &HFE)) Or _
(b1 = &H8E And (&HA1 <= b2 And b2 <= &HDF)) Then
euc = euc + 2
i = i + 1
ElseIf i < bLen - 2 Then
b3 = bytes(i + 2)
If b1 = &H8F And (&HA1 <= b2 And b2 <= &HFE) And _
(&HA1 <= b3 And b3 <= &HFE) Then
euc = euc + 3
i = i + 2
End If
End If
Next
For i = 0 To bLen - 2
b1 = bytes(i)
b2 = bytes(i + 1)
If (&HC0 <= b1 And b1 <= &HDF) And _
(&H80 <= b2 And b2 <= &HBF) Then
utf8 = utf8 + 2
i = i + 1
ElseIf i < bLen - 2 Then
b3 = bytes(i + 2)
If (&HE0 <= b1 And b1 <= &HEF) And _
(&H80 <= b2 And b2 <= &HBF) And _
(&H80 <= b3 And b3 <= &HBF) Then
utf8 = utf8 + 3
i = i + 2
End If
End If
Next
Select Case True
Case euc > sjis And euc > utf8
getCharFromCode = "EUC-JP"
Case utf8 > euc And utf8 > sjis
getCharFromCode = "UTF-8N"
Case sjis > euc And sjis > utf8
getCharFromCode = "SHIFT-JIS"
Case Else '判定できず
getCharFromCode = ""
End Select
End Function
※Tabが"で囲まれていないCSVの場合
Tabが"で囲まれていないCSVの場合は、
Case ",", vbTab '「"」が偶数なら区切り、奇数ならただの文字
このvbTabを消してください。
前作の、Case ",", vbTab '「"」が偶数なら区切り、奇数ならただの文字
このvbTabを消してください。
CSVの読み込み方法（ジャグ配列）
・CSVの読み込み方法（改の改）での予告 ・CSV読み込みでのジャグ配列の使いどころ ・CSV読み込みVBAコード：ジャグ配列バージョン ・最後に ・本サイトにあるCSV関連記事一覧
これとの違いは、文字コード自動判別のgetCharSetと、参照設定をCreateObjectに変更しているだけになります。
参照設定を外しているので、各種定数（ForAppending、TristateTrue）も直接数値に変更しています。
※文字コード自動判定の作成にあたって
以下のサイトに掲載されているコードをもとに若干の修正を加えつつVBAに移植したものになります。
文字コードを判別する - .NET Tips (VB.NET,C#...)
https://dobon.net/vb/dotnet/string/detectcode.html
Windows10のメモ帳もデフォルトがUTF-8になりました。文字コードを判別する - .NET Tips (VB.NET,C#...)
https://dobon.net/vb/dotnet/string/detectcode.html
EUC-JP、UTF-32 LE、UTF-32 BEについては、確認テストが困難なため、
文字コード判定のみ実装し、実際のCSV読込については未実装です。
CSVの読み込み方法（ジャグ配列）（改）の使用例
Sub sample()
Dim ws As Worksheet
Dim vFile As Variant
vFile = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
Title:="CSVファイルの選択")
If vFile = False Then Exit Sub
'出力シート
Set ws = ActiveSheet
ws.Cells.Clear
'全列を文字に設定、数値も文字としてセルに入ります
'文字設定にしなければ数値は数値として入ります。
ws.Cells.NumberFormatLocal = "@"
'CSV取込、文字コード自動判別
Application.ScreenUpdating = False
Call CsvToSheet(ws, vFile)
Application.ScreenUpdating = True
End Sub
CSVの読み込み方法（ジャグ配列）の使用例です。
上記では、全列を文字設定にしていますが、数値はセルに数値（先頭0が消える）として出力する場合は、
当該列の表示形式を「G/標準」または数値の書式設定（#,##0等）にしてください。
本サイトにあるCSV関連記事一覧
VBAでのCSVの扱い方まとめ
※ほとんどの記事でUTF-8に対応しています。
・本サイトにあるCSV関連記事一覧 ・CSVの読込方法 ・CSVの読み込み方法（改） ・CSVの読み込み方法（改の改） ・CSVの読み込み方法（ジャグ配列） ・CSVの読み込み方法（ジャグ配列）（改） ・CSVの出力（書き出し）方法 ・UTF-8でCSVの読み書き（ADODB.Stream） ・ADOでCSVの読み込み（SQL）
CSVの読込方法・もっとも簡単かつ良くあるCSV読み込みVBAコード ・「,」「"」に対応したCSV読み込みVBAコード ・CSVをExcelブックとして開くVBA ・クエリーテーブルを使ったCSV読み込みVBAコード ・その他のCSV読み込み方法
CSVの読み込み方法（改）実施したいこと ・ファイル名を指定し、形式をカンマ区切り、文字列で開く、その際、改行コードLF、CRLF、CRいずれにも対応、セル内の","や改行についてはカラムで区切らない。掲示板で上記のリクエストを頂きました。ということで、対応ロジックを書いてみました。
CSVの読み込み方法（改の改）・CSVの形式について ・CSV読み込みVBAコード ・配列を使ってシートにまとめて出力する場合 ・QueryTablesを使ったCSV読み込みVBAコード ・本サイトにあるCSV関連記事一覧
CSVの読み込み方法（ジャグ配列）・CSVの読み込み方法（改の改）での予告 ・CSV読み込みでのジャグ配列の使いどころ ・CSV読み込みVBAコード：ジャグ配列バージョン ・最後に ・本サイトにあるCSV関連記事一覧
CSVの読み込み方法（ジャグ配列）（改）・CSV読み込みVBAコード：CSVの読み込み方法（ジャグ配列）（改） ・CSVの読み込み方法（ジャグ配列）（改）の使用例 ・本サイトにあるCSV関連記事一覧
CSVの出力（書き出し）方法・エクセルの機能をそのまま利用します ・直接CSVを出力 ・本サイトにあるCSV関連記事一覧
UTF-8でCSVの読み書き（ADODB.Stream）・アクティブシートの内容をUTF-8でCSV出力します ・UTF-8のCSVを読込、シートに出力します ・ADODB.Streamのメソッドとプロパティ ・本サイトにあるCSV関連記事一覧
ADOでCSVの読み込み（SQL）・CSVテストデータ ・ADOでCSV読込のVBA ・ADO使用時の注意点 ・ADOレコードセットをCSV出力 ・ADOでTSVの読み込み ・ADOでCSVの読み込みについて ・本サイトにあるCSV関連記事一覧
※ほとんどの記事でUTF-8に対応しています。
同じテーマ「マクロVBAサンプル集」の記事
VBAでのCSVの扱い方まとめ
CSVの読み込み方法
CSVの読み込み方法（改）
CSVの読み込み方法（改の改）
CSVの読み込み方法（ジャグ配列）
CSVの読み込み方法（ジャグ配列）（改）
CSVの出力（書き出し）方法
UTF-8でCSVの読み書き（ADODB.Stream）
ADOでマスタ付加と集計（SQL）
ADOでマスタ更新（SQL）
ADOでCSVの読み込み（SQL）
新着記事NEW ・・・新着記事一覧を見る
TRIMRANGE関数（セル範囲をトリム：端の空白セルを除外）｜エクセル入門(2024-08-30)
正規表現関数（REGEXTEST,REGEXREPLACE,REGEXEXTRACT）｜エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない｜エクセル雑感(2024-04-11)
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成｜ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。｜エクセル雑感(2024-02-17)
初級脱出10問パック｜VBA練習問題(2024-01-24)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.繰り返し処理（For Next)｜VBA入門
3.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
4.変数宣言のDimとデータ型｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
7.セルのクリア（Clear,ClearContents）｜VBA入門
8.メッセージボックス(MsgBox関数)｜VBA入門
9.条件分岐（Select Case）｜VBA入門
10.ブック・シートの選択（Select,Activate）｜VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- CSVの読み込み方法（ジャグ配列）（改）
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。