ExcelマクロVBAサンプル集 | CSVの読み込み方法(改の改) | Excelマクロの実用サンプル、エクセルVBA集と解説



最終更新日:2017-03-17

CSVの読み込み方法(改の改)

CSVの読込方法については複数の記事を掲載しており、人気記事として多くのアクセスがあります、

掲載しているVBAコードは汎用的に書いてあり、ほぼそのまま使用できるものです。

しかし、

CSVは多くの形式(区切り文字、文字コード等)があり、今まで掲載したコードでは解決出来ないものがあります。


そこで、今回は今まで対応していなかった形式も含めて、

通常考えられる形式を全て処理可能なコードを提示します。

CSVの形式について
区切り文字
カンマ区切り
Comma Separated Values
ファイルの拡張子はcsv

タブ区切り
Tab Separated Values
ファイルの拡張子はtsvまたはcsv

狭義でのCSVは、もちろんカンマ区切りですが、
拡張子がcsvでタブ区切りのファイルも結構存在しており、Excelでは普通に開くことが出来ます。
拡張子のcsvがExcelに標準で紐ついていて、Excelがタブ区切りも読めるので、
本来ならtsvなのでしょうが、拡張子がcsvとなっているタブ区切りも多く存在します。
文字コード
Shit-JIS
Windowsでは標準ともいえる文字コードです。
Windowsで作成したcsvなら、ほとんどがShit-Jisでしよう。
メモ帳で保存時には、「ANSI」になります。

UTF-8
BOM付きとBOM無しがあります。
BOM無しはUTF-8Nと言われたりしますが、ここでは呼び方よりも

Unicode
文字コードというより、文字集合と言った方が正しいのかもしれませんが、
ここでは、
UTF-16
と認識していただければ良いでしょう。

Unicode big endian
Unicodeには、複数バイトで構成されるデータの並べ方で、エンディアンというものがあり、
ビッグエンディアンとリトルエンディアンがある。
メモ帳でも保存時の、
「Unicode」は、リトルエンディアン
「Unicode big endian」は、ビッグエンディアン


結果として、上記の区切り文字と文字コードの組み合わせが存在することになります。
全ての組み合わせで処理可能なVBAコードを作ることが目的です。

CSVの読み込み方法(改)
UTF-8でCSVの読み書き(ADODB.Stream)

これらのページで掲載しているVBAコードを改造し、
テキストの文字コードを判定を加えたものです。

Sub sample1()
  Dim ws As Worksheet
  Dim sFile As String
  sFile = "パス\test.csv"
  
  Set ws = Worksheets("Sheet1")
  ws.Cells.Clear
  ws.Cells.NumberFormatLocal = "@"
  Call CsvInText(ws, sFile)
End Sub

Sub CsvInText(ByVal ws As Worksheet, ByVal strFile As String)
  Dim objFSO As New FileSystemObject
  Dim inTS As TextStream
  Dim adoSt As New ADODB.Stream
  Dim strRec As String
  Dim aryRec() As String
  Dim strSplit() As String
  Dim i As Long, j As Long, k As Long
  Dim lngQuate As Long
  Dim strCell As String
  Dim blnCrLf As Boolean

  Select Case LCase(getCharSet(CStr(strFile)))
    Case "unicode", "unicodefeff"
      'TristateTrueで読込
      Set inTS = objFSO.OpenTextFile(CStr(strFile), ForReading, , TristateTrue)
      strRec = inTS.ReadAll
    Case "utf-8"
      'ADOを使って読込、その後の処理を統一するため全レコードをCRLFで結合
      With adoSt
        .Type = adTypeText
        .charSet = "UTF-8"
        .Open
        .LoadFromFile strFile
        i = 0
        Do While Not (.EOS)
          ReDim Preserve aryRec(i)
          aryRec(i) = .ReadText(adReadLine)
          i = i + 1
        Loop
        .Close
        strRec = Join(aryRec, vbCrLf)
      End With
    Case Else
      Set inTS = objFSO.OpenTextFile(CStr(strFile), ForReading)
      strRec = inTS.ReadAll
  End Select
  
  i = 1 'シートの1行目から出力
  j = 0 '列位置はPutCellでカウントアップ
  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 PutCell(ws, i, j, strCell, lngQuate)
            i = i + 1
            j = 0
            lngQuate = 0
            strCell = ""
          End If
        Else
          strCell = strCell & Mid(strRec, k, 1)
        End If
      Case ",", vbTab '「"」が偶数なら区切り、奇数ならただの文字
        If lngQuate Mod 2 = 0 Then
          Call PutCell(ws, i, 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 PutCell(ws, i, j, strCell, lngQuate)
  End If
  
  Set inTS = Nothing
  Set objFSO = Nothing
End Sub

Sub PutCell(ByVal ws As Worksheet, ByRef i As Long, 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
  ws.Cells(i, j) = strCell
  strCell = ""
  lngQuate = 0
End Sub

Function getCharSet(ByVal sFile As String) As String
  Dim objHtml As MSHTML.HTMLDocument
  'GetObjectでHTMLDocumentを生成し、文字コードを判定する
  Set objHtml = GetObject(sFile, "htmlfile")
  Do While objHtml.readyState <> "complete"
    DoEvents
  Loop
  getCharSet = objHtml.charSet
  Set objHtml = Nothing
End Function

参照設定
Microsoft Script Runtime
Microsoft ActiveX Data Objects x.x Library
Microsoft Html Object Library

VBAコードについては解説しきれないので、
コード内のコメントを参考にしてください。

区切り文字と文字コードの主要な組み合わせについては、
テストデータを作成して確認しましたが、漏れがあるかもしれません。
VBA開発で実際に使う事もあるので、気が付いた時点で修正します。
また、上手く動かない等に気づいたときにご一報をいただければ修正します。


Unicode big endian の対応が必要ないのであれば、
以下のQueryTablesを使った簡単なコードで対応できます。

Sub sample2()
  Dim ws As Worksheet
  Dim sFile As String
  sFile = "パス\test.csv"
  
  Set ws = Worksheets("Sheet1")
  ws.Cells.Clear
  ws.Cells.NumberFormatLocal = "@"
  Call CsvInQuery(ws, sFile)
End Sub

Sub CsvInQuery(ByVal ws As Worksheet, ByVal sFile As String)
  Dim cArray() As Integer
  Dim i As Long
  
  ReDim cArray(255)
  For i = 0 To 255
    cArray(i) = XlColumnDataType.xlTextFormat
  Next
  With ws.QueryTables.Add(Connection:="TEXT;" & sFile, Destination:=ws.Range("$A$1"))
    .TextFileTabDelimiter = True
    .TextFileCommaDelimiter = True
    .TextFileColumnDataTypes = cArray
    Select Case LCase(getCharSet(CStr(sFile)))
      Case "utf-8", "unicode", "unicodefeff"
        .TextFilePlatform = 65001
      Case Else
        .TextFilePlatform = 932
    End Select
    .Refresh BackgroundQuery:=False
    .Delete
  End With
End Sub

Function getCharSet(ByVal sFile As String) As String
  Dim objHtml As MSHTML.HTMLDocument
  
  Set objHtml = GetObject(sFile, "htmlfile")
  Do While objHtml.readyState <> "complete"
    DoEvents
  Loop
  getCharSet = objHtml.charSet
  
  Set objHtml = Nothing
End Function


要点としては、
TextFileColumnDataTypes
ここには、実際のカラム数以上を指定しても問題ありません。
上記では、256列全てを文字列指定にしています。
また、区切り文字として、カンマとタブを指定しておくことで、どちらにも対応できます。
これにより、VBAコードを変更することなく、上記のコードでほとんどのCSVを処理可能としています。
ただし、Unicode big endian については、QueryTablesは対応できません。

本記事は、私自身の備忘録であり、
VBA開発時には、CSV読込の雛形コードとして使えるようにする意味もあり、ここに掲載しました。




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

CSVの出力(書き出し)方法
UTF-8でCSVの読み書き(ADODB.Stream)
ADOでマスタ付加と集計(SQL)
ADOでマスタ更新(SQL)
ADOでCSVの読み込み(SQL)
Excelファイルを開かずにシート名を取得
Excelファイルを開かずにシート名をチェック

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

空白セルを正しく判定する方法2|ExcelマクロVBA技術解説(5月6日)
フルパスをディレクトリ、ファイル名、拡張子に分ける|ExcelマクロVBA技術解説(4月15日)
テキストボックスの各種イベント|Excelユーザーフォーム入門(4月9日)
フォルダ(サブフォルダも全て)削除する、Optionでファイルのみ削除|ExcelマクロVBAサンプル集(4月4日)
最後の空白(や指定文字)以降の文字を取り出す|エクセル関数超技(3月26日)
先頭の数値、最後の数値を取り出す|エクセル関数超技(3月26日)
Excelファイルを開かずにシート名をチェック|ExcelマクロVBAサンプル集(3月23日)
数式の参照しているセルを取得する|ExcelマクロVBAサンプル集(3月18日)
CSVの読み込み方法(改の改)|ExcelマクロVBAサンプル集(3月17日)
変数とプロシージャーの命名について|ExcelマクロVBA技術解説(2月12日)

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

1.最終行の取得(End,Rows.Count)|ExcelマクロVBA入門
2.ひらがな⇔カタカナの変換|エクセル基本操作
3.RangeとCellsの使い方|ExcelマクロVBA入門
4.Range以外の指定方法(Cells,Rows,Columns)|ExcelマクロVBA入門
5.徹底解説(VLOOKUP,MATCH,INDEX,OFFSET)|エクセル関数超技
6.変数とデータ型(Dim)|ExcelマクロVBA入門
7.セルの参照範囲を可変にする(OFFSET,COUNTA,MATCH)|エクセル関数超技
8.セルのコピー&値の貼り付け(PasteSpecial)|ExcelマクロVBA入門
9.CSVの読み込み方法|ExcelマクロVBAサンプル集
10.定数と型宣言文字(Const)|ExcelマクロVBA入門



  • >
  • >
  • >
  • CSVの読み込み方法(改の改)

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


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




    ↑ PAGE TOP