VBAサンプル集
CSVの読み込み方法(ジャグ配列)(改)

ExcelマクロVBAの実用サンプル、エクセルVBA集と解説
最終更新日:2019-11-11

CSVの読み込み方法(ジャグ配列)(改)

CSVのマクロVBAでの読込方法についての記事は、人気記事として多くのアクセスがあります。
順次改定していくつかのバージョンが存在します。
最新のジャグ配列(配列の配列)で読み込むVBAについて、UTF-8Nの文字コード判別の課題が残っていました。


文字コードの判定を全て完璧に行うのは無理ですが、簡易的にでもUTF-8Nを判定したいところです。
そこで、いろいろなサイトを参考にして、これに対応するVBAを作成しました。
また、使うにあたって参照設定が面倒な場合もあるので、参照設定せずにCreateObjectに変更してコピペで使いやすくしています。

現在、本サイト内のCSV関連としては以下のページがあります。

VBAでのCSVの扱い方まとめ
マクロVBAでCSVの読み書きする方法はいくつもあり、当サイトでも複数のページでそれぞれVBAコードを掲載しています。順次記事を掲載しているので、それぞれどのような特徴があるかが良く分からなくなってしまっているようです。そこで、CSVに関するページをまとめておきました。
CSVの読み込み方法
エクセルのVBAでのCSVの読込方法としては。・テキストファイルとして読み込む ・ワークブックとして読み込む ・クエリーテーブルを使う ・ADOを使う ・PowerQueryを使う 大別するとこのようになります。この記事を書いた当初は、エクセルのVBAでCSVの読み込みについてネットで検索したところ、
CSVの読み込み方法(改)
実施したいこと ・ファイル名を指定し、形式をカンマ区切り、文字列で開く、その際、改行コードLF、CRLF、CRいずれにも対応、セル内の","や改行についてはカラムで区切らない。掲示板で上記のリクエストを頂きました。ということで、対応ロジックを書いてみました。
CSVの読み込み方法(改の改)
CSVのVBAでの読込方法については複数の記事を掲載しており、人気記事として多くのアクセスがあります。掲載しているVBAコードは汎用的に書いてあり、ほぼそのまま使用できるものです。しかし、CSVは多くの形式(区切り文字、文字コード等)があり、今まで掲載したコードでは解決出来ないものがあります。
CSVの読み込み方法(ジャグ配列)
CSVのマクロVBAでの読込方法についての記事は、人気記事として多くのアクセスがあります。当初作成して以来、ご要望をいただいたり自身で使っている中で、対応できないCSVが出てくるたびに改良を重ねています。今回のVBAは、一旦ジャグ配列を使用したCSV読み込み方法になります。
CSVの出力(書き出し)方法
シート内容をCSV出力(書き出し)する方法です。CSVの読込は、「CSVの読込方法」「CSVの読込方法(改)」実施したいこと・ファイル名を指定し、形式をカンマ区切り、文字列で開く、その際、改行コードLF、CRLF、CRいずれにも対応、セル内の","や改行についてはカラムで区切らない。
UTF-8でCSVの読み書き(ADODB.Stream)
VBAでUTF-8を扱う為には、ADODB.Streamを使う必要があります。以下のコードを使用するには、参照設定で、「MicrosoftActiveXDataObjects2.8Library」にチェックを付けて下さい。または、DimadoStAsNewADODB.Stream ここを DimadoStAsObject SetadoSt=CreateO…

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

'ジャグ配列を2次元配列に変換
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 Integer
  
  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 Integer: sjis = 0
  Dim euc As Integer: euc = 0
  Dim utf8 As Integer: 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

前作の、
CSVの読み込み方法(ジャグ配列)
CSVのマクロVBAでの読込方法についての記事は、人気記事として多くのアクセスがあります。当初作成して以来、ご要望をいただいたり自身で使っている中で、対応できないCSVが出てくるたびに改良を重ねています。今回のVBAは、一旦ジャグ配列を使用したCSV読み込み方法になります。
これとの違いは、
文字コード自動判別のgetCharSetと、参照設定をCreateObjectに変更しているだけになります。
参照設定を外しているので、各種定数(ForAppending、TristateTrue)も直接数値に変更しています。

文字コードの判定は、これで完璧ということではありません。
※文字コード自動判定の作成にあたって
以下のサイトに掲載されているコードをもとに若干の修正を加えつつVBAに移植したものになります。
文字コードを判別する - .NET Tips (VB.NET,C#...)
https://dobon.net/vb/dotnet/string/detectcode.html
Windows10のメモ帳もデフォルトがUTF-8になりました。

VBA マクロ CSV 文字コード自動判別

これらの文字コードについてのみ対応したものになります。
EUC-JPUTF-32 LEUTF-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等)にしてください。



同じテーマ「VBAサンプル集」の記事

VBAでのCSVの扱い方まとめ
CSVの読み込み方法
CSVの読み込み方法(改)
CSVの読み込み方法(改の改)
CSVの読み込み方法(ジャグ配列)
CSVの読み込み方法(ジャグ配列)(改)
CSVの出力(書き出し)方法
UTF-8でCSVの読み書き(ADODB.Stream)
ADOでマスタ付加と集計(SQL)
ADOでマスタ更新(SQL)
ADOでCSVの読み込み(SQL)


新着記事NEW ・・・新着記事一覧を見る

SQL関数と演算子|SQL入門(12月1日)
データの取得:集約集計、並べ替え(DISTINKT,GROUP BY,ORDER BY)|SQL入門(11月30日)
データの取得:条件指定(SELECT,WHERE)|SQL入門(11月29日)
データの挿入:バルクインサート|SQL入門(11月28日)
データの挿入(INSERT)と全削除|SQL入門(11月26日)
テーブル名変更と列追加(ALTER TABLE)とテーブル自動作成|SQL入門(11月25日)
テーブルの作成/削除(CREATE TABLE,DROP TABLE)|SQL入門(11月24日)
データベースに接続/切断|SQL入門(11月23日)
SQLiteのインストール|SQL入門(11月22日)
SQL入門:VBAでデータベースを使う|エクセルの神髄(11月22日)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.RangeとCellsの使い方|VBA入門
4.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.繰り返し処理(For Next)|VBA入門
7.マクロって何?VBAって何?|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.空白セルを正しく判定する方法(IsEmpty,IsError,HasFormula)|VBA技術解説
10.ひらがな⇔カタカナの変換|エクセル基本操作



  • >
  • >
  • >
  • CSVの読み込み方法(ジャグ配列)(改)

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
    掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



    このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
    本文下部へ