第4回 直感！スグに使える業務向けVBA汎用プロシージャ(CSV保存)

第0回で配布しました汎用プロシージャのコードの紹介と簡単な解説をやっていきたいと思います！
以下のリンクから .bas ファイルをダウンロードできます（zipファイル）

今回ご紹介するプロシージャは

プロシージャ名	概要
ArrayToCsv	配列をCSV形式で保存(Shift_JIS、インデックスは1開始)
ArrayToCsv_UTF8	配列をCSV形式で保存(UTF-8、インデックスは1開始)

今回は配列の中身をそのままCSVファイルに保存できてしまうというプロシージャです！Excelユーザーですと.xlsxファイルと.csvってなんとなく同じものみたいに扱うことが多いですが、簡単にCSVファイルと何かをおさらいしましょう。

CSVファイルとは

CSVファイルは、英語でComma Separated Valuesの略で各項目がカンマ(,)で区切られたテキストファイルのことです。そう、テキストファイルなんです。テキストファイルでありながらカンマで区切られているためExcelのようなスプレッドシートでも取り扱うことができるというファイル形式です。

CSVファイルのメリットとしてExcelのみならず様々なツールで取り扱うことができる、データ容量が軽いなどが挙げられます。ロガーなどの測定器の出力ファイルなどがCSVファイルですね。(極稀にカンマ区切りではなく半角スペース区切りで.datファイルなんてパターンもありますね...)

そして今回、Shift_JIS版とUTF-8版と2種類の保存方式をご用意しました。文字コードというものをご存じない方向けに簡単に説明しますと、文字コードとはコンピュータが文字を処理するために特定のデータに文字をあてはめたもので、Shift_JISは日本語のシステムでよく使われる日本語処理に特化した文字コードになり、UTF-8は世界中の多くの言語に対応した国際標準の文字コードになります。

日本語ExcelなどはShift_JISが使われているのですが、PythonなどではUFT-8が使われており保存形式を揃えないと文字化けを起こしてしまします。

日本語Excelのみで完結するシステムであればShift_JIS版で大丈夫ですが、生成したCSVファイルをPythonなどの別のシステムで処理したい場合はUTF-8版をお使いください。

それではコードの紹介です！

ArrayToCsv

Sub ArrayToCsv(dataArray As Variant, Optional csvPath As String = "")
'------------------------------------------------------------------------------------------------------------------------------
'　概要　　｜配列の内容をCSV形式で保存する
'------------------------------------------------------------------------------------------------------------------------------
'　引数１　｜dataArray - 保存対象の2次元配列(インデックスは1開始)
'　引数２　｜csvPath - 保存先のCSVファイルパス(省略時はダイアログ表示)
'------------------------------------------------------------------------------------------------------------------------------
'　実装　　｜Ver.1.0.0(2025/04/20:新規)
'------------------------------------------------------------------------------------------------------------------------------

    Dim vLoop       As Long '行ループカウンタ
    Dim hLoop       As Long '列ループカウンタ
    Dim fileNum     As Long 'ファイルハンドル
    Dim rowText     As String '行ごとのセル内容の文字列
    Dim csvSafe     As String 'セル内容変換用変数
    
    'ユーザー定義エラー
    If IsArray(dataArray) <> True Then
        Err.Raise vbObjectError + 1001, "ArrayToCsv", "第一引数は配列を指定してください"
    End If
    
    'ファイルパスが空なら保存先ダイアログ表示
    If csvPath = "" Then
        csvPath = Application.GetSaveAsFilename("output.csv", "CSVファイル (*.csv), *.csv")
        If csvPath = "False" Then Exit Sub 'キャンセル時
    End If
    
    'ファイル書き込み開始(Shift_JIS)
    fileNum = FreeFile
    Open csvPath For Output As #fileNum
    For vLoop = 1 To UBound(dataArray, 1)
        rowText = ""
        For hLoop = 1 To UBound(dataArray, 2)
            'セル内ダブルクオーテーション等の変換
            csvSafe = dataArray(vLoop, hLoop)
            csvSafe = Replace(csvSafe, """", """""")
            If InStr(csvSafe, ",") > 0 Or InStr(csvSafe, """") > 0 Or InStr(csvSafe, vbCr) > 0 Or InStr(csvSafe, vbLf) > 0 Then
                csvSafe = """" & csvSafe & """"
            End If
            rowText = rowText & csvSafe & ","
        Next hLoop
        rowText = Left(rowText, Len(rowText) - 1) '最後の区切り文字削除
        Print #fileNum, rowText
    Next vLoop
    
    Close #fileNum
    
End Sub

ArrayToCsv_UTF8

Sub ArrayToCsv_UTF8(dataArray As Variant, Optional csvPath As String = "")
'------------------------------------------------------------------------------------------------------------------------------
'　概要　　｜配列の内容をUTF-8形式でCSV保存する
'------------------------------------------------------------------------------------------------------------------------------
'　引数１　｜dataArray - 保存対象の2次元配列(インデックスは1開始)
'　引数２　｜csvPath - 保存先のCSVファイルパス(省略時はダイアログ表示)
'------------------------------------------------------------------------------------------------------------------------------
'　実装　　｜Ver.1.0.0(2025/04/20:新規)
'------------------------------------------------------------------------------------------------------------------------------
    
    Dim vLoop       As Long '行ループカウンタ
    Dim hLoop       As Long '列ループカウンタ
    Dim rowText     As String '行ごとのセル内容の文字列
    Dim csvSafe     As String 'セル内容変換用変数
    Dim csvContent  As String 'CSVテキスト
    Dim stream      As Object
    
    'ユーザー定義エラー
    If IsArray(dataArray) <> True Then
        Err.Raise vbObjectError + 1001, "ArrayToCsv_UTF8", "第一引数は配列を指定してください"
    End If
    
    If csvPath = "" Then
        csvPath = Application.GetSaveAsFilename("output_utf8.csv", "CSVファイル (*.csv), *.csv")
        If csvPath = "False" Then Exit Sub
    End If
    
    'CSVテキストを構築
    For vLoop = 1 To UBound(dataArray, 1)
        rowText = ""
        For hLoop = 1 To UBound(dataArray, 2)
            'セル内ダブルクオーテーション等の変換
            csvSafe = CStr(dataArray(vLoop, hLoop))
            csvSafe = Replace(csvSafe, """", """""")
            If InStr(csvSafe, ",") > 0 Or InStr(csvSafe, """") > 0 Or InStr(csvSafe, vbCr) > 0 Or InStr(csvSafe, vbLf) > 0 Then
                csvSafe = """" & csvSafe & """"
            End If
            rowText = rowText & csvSafe & ","
        Next hLoop
        rowText = Left(rowText, Len(rowText) - 1) '最後の区切り文字削除
        csvContent = csvContent & rowText & vbCrLf
    Next vLoop
    
    'ADODB.StreamでUTF-8書き込み
    Set stream = CreateObject("ADODB.Stream")
    With stream
        .Charset = "utf-8"
        .Open
        .WriteText csvContent
        .SaveToFile csvPath, 2 '2=上書き保存
        .Close
    End With
    Set stream = Nothing
    
End Sub

動作解説

コードの中身はShift_JIS版とUTF-8版で違う部分がありますが、やっていることは文字コード以外同じであるため今回はShift_JIS版のみの解説とさせていただきます。

では、第2回でも出てきたこの表をCSVファイルにしてみましょう！
第3回に出てきたCellToArrayを使ってA1セルからF9セルまでを配列Aに格納してCSVファイルとして保存します。

Sub Main()
    
    Dim A As Variant
    
    A = CellToArray(1, 1, 9, 6)
    Call ArrayToCsv(A)
    
End Sub

実はこれだけで保存できてしまいます！また、ArrayToCsvの第2引数を指定しない場合はダイアログボックスが表示され任意のフォルダに任意のファイル名で保存ができます。(デフォルトは"output.csv")
また、第2引数にファイル名を含めたフルパスを指定するとダイアログボックスが表示されずそのまま保存されます。大量のCSVファイルを生成したい際はこちらの方法をオススメします。
では、生成されたoutput.csvを見てみましょう。

そしてメモ帳で開くと...

しっかりカンマ区切りのテキストファイルになっていることが確認できました！
最終的に作りたいシステムに合わせてShift_JIS版とUTF-8版を使い分けてみてください！

直感！VBAシリーズ記事一覧

もしよろしければ他の記事もご覧ください！