Excel VBAでCSVファイルを自在に読み込む：ゼロ落ちなし、数値・文字列OK

何がしたいのか

CSVファイルをエクセル形式にインポートする際、次のような要件を満たしたいです。

• コードなど文字列の項目はゼロ落ちしないように文字列で取り込みたい
• 数値や金額の項目は集計しやすいように数値や金額で取り込みたい
• 上記の要件を、エクセルの書式設定と同じレベルで、簡単に自由にできるようにしたい

CSVファイルを貼り付けるフォーマットのエクセル形式のファイルに、あらかじめ書式設定で文字列や数値・金額などの設定をしておくことで、データ型が設定されるようにします。
この方法はネットで検索できなかったため、作成したコードを共有しますので、参考にしてください。

動作確認済みの環境

以下の環境で動作を確認しています。

• Windows11 Microsoft Excel 2016(32bit)
• Windows11 Microsoft Excel 2019(64bit)
• Windows10 Microsfot365 Excel 2406(32bit)

2024年現在サポートのあるエクセルであれば動作するはずです。

※Microsfot365 Excel 2406では、手作業であればゼロ落ちなしでCSVファイルを開くことができるようになっています。ただし、VBAでの方法があるかはわかりませんでした。オプションから設定を変更したうえで、Workbooks.openをしてもゼロ落ちしてしまいます。
参考：エクセル（Excel）の新機能で、CSVファイルの0落ちを回避する | タイムカード・勤怠管理のiPadアプリ 【タブレット タイムレコーダー】

対応方針

いったんすべての項目を文字列としてエクセルの機能で読み込み、それを二次元配列へ格納。書式の設定されたセル範囲へ二次元配列から転記することで、書式にあったデータ型へ変換される挙動を利用します。

動作イメージ

CSVファイルを用意

下のようなファイルを読み込みたいとします。

test/in.csv

id,amount,percentage
001,004998339,0.125
002,000499833,0.252
003,007622957,0.871
004,008377090,0.084

フォーマットファイルを用意

必要に応じて、各項目に文字列や金額などの書式を設定しています。
2行目は設定した書式がわかるように入力したダミーデータです。

• test/fmt.xlsx
  

VBAを実行

CSV2XLSX "test\in.csv", "test\fmt.xlsx", "test\out.xlsx", "Sheet1!$A$2"

出力を確認

フォーマットに設定した形式で読み込まれます。

• test/out.xlsx
  

VBAコード

以下のコードを標準モジュールに貼り付け、main_Csv2Xlsx()内のファイル名等は適宜変更してください。
このバージョンではエラー処理をあまり書いていないので、ファイルが見つからないと何も言わずに終了します。適宜処理を追加してください。

Option Explicit

'メイン処理
Sub main_Csv2Xlsx()
    CSV2XLSX "test\in.csv", "test\fmt.xlsx", "test\out.xlsx", "Sheet1!$A$2"
End Sub

'CSVファイルを読み込み、エクセルフォーマットに指定した書式に合わせたデータを貼り付ける
Function CSV2XLSX(strCSVFullname As String, strFMTFullname As String, strOutputFullname As String, strPasteRange As String, Optional lInOffset As Long = 1)

    'ファイルチェック・ファイル名取得（CSVファイルはワイルドカード使用可能）
    If strCSVFullname = "" Or strFMTFullname = "" Then Exit Function
    
    If Not getFSO().FileExists(ConfirmPath(strFMTFullname)) Then Debug.Print "▲ファイルが見つかりません:" & strFMTFullname: Exit Function
    strFMTFullname = strFMTFullname
    
    
    'CSVファイルを文字列として読み込み
    Dim wsCSV As Worksheet
    Set wsCSV = OpenCSVAsString(ConfirmPath(strCSVFullname))
    If wsCSV Is Nothing Then Exit Function
    
    'フォーマットファイルを読み込み
    Dim wbFMT As Workbook
    Set wbFMT = Workbooks.Open(ConfirmPath(strFMTFullname))
    If wbFMT Is Nothing Then Exit Function
    
    Dim rgPaste As Range
    Set rgPaste = strRgToRange(wbFMT, strPasteRange)
    If rgPaste Is Nothing Then Exit Function
    
    'CSVファイルのデータを2次元配列に読込、シートへ貼付
    Dim mat1 As Variant
    mat1 = wsCSV.Cells(1, 1).CurrentRegion.Offset(lInOffset).value
    rgPaste.Resize(UBound(mat1, 1), UBound(mat1, 2)) = mat1
    wsCSV.Parent.Close False
    
    '保存
    If strOutputFullname <> "" Then
        wbFMT.SaveAs ConfirmPath(strOutputFullname)
        wbFMT.Close False
    End If
End Function

Function strRgToRange(wb1 As Workbook, strRg As String) As Range
'「シート名！セル範囲」の文字列を、Rangeオブジェクトにして返す
    If strRg = "" Then Exit Function
    Set strRgToRange = wb1.Sheets(Left(strRg, InStr(strRg, "!") - 1)).Range(Mid(strRg, InStr(strRg, "!") + 1))
End Function

Function OpenCSVAsString(strCSVFullname As String) As Worksheet
'CSVファイルのパスを受け取り、文字列として展開したシートを返す
    Dim ws1 As Worksheet
    Dim lColumnCount As Long
    
    If Not getFSO().FileExists(strCSVFullname) Then Exit Function

    '列数取得（全ての列を文字列で取得する設定のために必要）
    lColumnCount = GetColumnCountFromCSV(strCSVFullname)
        
    '全ての列を文字列で取得する設定にする
    Dim ColumnDataTypes() As Variant
    ReDim ColumnDataTypes(1 To lColumnCount)
    Dim i As Long
    For i = 1 To lColumnCount
        ColumnDataTypes(i) = xlTextFormat
    Next
    
    ' 新しいワークシートを作成
    Set ws1 = Workbooks.Add.Sheets(1)

    ' QueryTableを使用してCSVファイルを開く
    With ws1.QueryTables.Add(Connection:="TEXT;" & strCSVFullname, Destination:=ws1.Cells(1, 1))
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFilePlatform = 65001  'UTF8
        .TextFileColumnDataTypes = ColumnDataTypes
        .Refresh
    
        .Delete
    End With
    Set OpenCSVAsString = ws1
End Function

Function GetColumnCountFromCSV(filePath As String) As Integer
'CSVファイルの項目数（列数）を見出し行のカンマの数で判定して返す
    Dim txtStream As Object
    Dim firstLine As String
    Dim columnCount As Integer

    ' テキストファイルを開く
    Set txtStream = getFSO().OpenTextFile(filePath, 1, False)   ' 1はForReading

    ' 最初の行を読み取る
    If Not txtStream.AtEndOfStream Then
        firstLine = txtStream.ReadLine
    End If

    ' テキストストリームを閉じる
    txtStream.Close

    ' カンマの数を数えて列数を推定
    columnCount = UBound(Split(firstLine, ",")) + 1

    ' 列数を返す
    GetColumnCountFromCSV = columnCount
End Function

'###################################################################
'# Helper Functions
'###################################################################

Function ConfirmPath(strPath As String) As String
'パス入力を受け取り、フルパスでなければこのファイルのパスからの相対パスとして扱う
    If Mid(strPath, 2, 2) <> ":\" And Left(strPath, 2) <> "\\" Then ConfirmPath = ThisWorkbook.path & "\" & strPath Else ConfirmPath = strPath
End Function

Function getFSO() As Object
    Set getFSO = CreateObject("Scripting.FileSystemObject")
End Function