「二次元配列」を「CSVファイル」に出力。ダブルクォーテーション有無、Shift-JIS/UTF-8選択可能。

このプロシージャは、引数として、「二次元配列」と「csvファイル名」を指定すると、配列がcsvファイルに出力されます。

「二次元配列」は、参照渡しになっています。また、一次元配列の場合は、エラーになりますので、ご注意願います。

3つ目の引数に、Trueを設定すると「””(ダブルクォーテーション)」でデータを囲います。Falseで「””(ダブルクォーテーション)」はなしになります。 省略時は、「””(ダブルクォーテーション)」なしです。

4つ目の文字コードを、「UTF-8」にしたい場合は、「utf-8」(空白でなければ、どのような文字でも良い)を入れてください。省略時は、「Shift_JIS」となります。

'*******
'* 二次元配列をCSVファイルに出力。20240202
'* 二次元配列専用に変更
'* https://loosecarrot.com/2020/02/15/3951/
'* arr:二次元配列。これが、csvファイルに出力される
'* FileName:csvファイル名、フルパス
'* DoubleQuotation:Trueで「""(ダブルクォーテーション)」でデータを囲う。Falseで「""(ダブルクォーテーション)」なし
'*                          省略時は、「""(ダブルクォーテーション)」なし。
'* code:文字コードを、「UTF-8」にしたい場合は、「utf-8」(空白でなければ、どのような文字でも良い)を入れる。省略時は、「Shift_JIS」となる。
Sub array_to_csv(ByRef arr As Variant, ByVal FileName As String, _
                Optional DoubleQuotation As Boolean, _
                Optional code As String)
    Dim startRow As Long                                '読込みする開始行
    Dim endRow As Long                                  '読込みする終了行
    Dim startCol As Long                                '読込みする開始列
    Dim endCol As Long                                  '読込みする終了行
    Dim outputArray As Variant                          'csv出力するデータの配列
    Dim csvFilePath As String                           'csv出力するパス
    Dim i As Integer                                    'ループ用変数
    Dim j As Long                                       'ループ用変数
    Dim outputText As String                            '出力テキストを格納
    
    outputArray = arr
    
    startCol = 1                                        '開始列
    startRow = 1                                        '開始行
    endCol = UBound(outputArray, 2)                     '最終列
    endRow = UBound(outputArray)                        '最終行
    
    '列×行数分ループ
    For i = 1 To endRow
        For j = 1 To endCol
            
            'カンマ区切り
            
            ' i行、j列、以下のみ、""なしの整数していた
            ' すべて「"」なし。数字変換もなし
            If Not DoubleQuotation And i > 0 And j > 0 Then
                'outputText = outputText & CLng(outputArray(i, j)) & ","
                outputText = outputText & outputArray(i, j) & ","
            Else
                outputText = outputText & """" & outputArray(i, j) & """" & ","
            End If
            
            ' 最終列が来て最終行でなければ、最後の「,」を削除して、改行追加
            If j = endCol And i <> endRow Then
                outputText = Left(outputText, Len(outputText) - 1) & vbCrLf
            ' 最終列が来て最終行ならば、最後の「,」を削除
            ElseIf j = endCol And i = endRow Then
                outputText = Left(outputText, Len(outputText) - 1)
            End If
        Next j
    Next i
    
    'csvファイルを書き込み
    '出力先とファイル名をセット
    csvFilePath = FileName
    
'    Open csvFilePath For Output As #1
'    Print #1, outputText
'    Close #1
    
    ' 「UTF-8」と「Shift_JIS」を切り替えられるように改造。20240201
    
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    stream.Open
    stream.Type = 2 ' テキストモード
    
    If code = "" Then
        stream.Charset = "shift_jis"
    Else
        stream.Charset = "utf-8"
    End If
    
    stream.WriteText outputText
    stream.SaveToFile csvFilePath, 2 ' オーバーライトモード
    stream.Close
    
End Sub

このプロシージャーは、「Excel VBAの配列からtsv・csvを出力する」を参考にしています。

以下が、使用例です。3つめの引数を、「True」にすることで、「””(ダブルクォーテーション)」でデータを囲います。

Dim arr() As Variant

Private Sub test、シートを配列に入れ、csvファイルに出力()
    Call sheet_to_array(ThisWorkbook.Worksheets("TEST"), arr)
    Call array_to_csv(arr, ThisWorkbook.Path & "\sample5.csv", True)
End Sub

実行すると、以下のシート「TEST」のデータが、配列に入ります。

これが以下のように配列に入ります。

そしてその配列が、以下のようにcsvファイルに出力されます。

「sheet_to_array」プロシージャーは、以下を参照してください。

次の使用例は、以下です。3つ目の引数に「True」を追加しました。それにより、「””(ダブルクォーテーション)」がなくります。

Dim arr() As Variant

Private Sub test、シートを配列に入れ、csvファイルに出力1()
    ' (ws, ByRef arr, Optional RejectRw = 0)
    Call sheet_to_array(ThisWorkbook.Worksheets("TEST"), arr)
    ' (ByRef arr, FileName, Optional 種類)
    Call array_to_csv(arr, ThisWorkbook.Path & "\sample6.csv", "サンプル")
End Sub

出力されるcsvファイルは以下になります。「””(ダブルクォーテーション)」が除外されます。

ここまでは、4つ目の引数が空白だったので、文字コードは、Shift-JISになっています。以下の通り「uft-8」と設定すると、文字コードは、UTF-8になります。

Dim arr() As Variant

Private Sub test、シートを配列に入れ、csvファイルに出力2()
    Call sheet_to_array(ThisWorkbook.Worksheets("TEST"), arr)
    Call array_to_csv(arr, ThisWorkbook.Path & "\sample7.csv", , "utf-8")
End Sub

出力されるcsvファイルは以下になります。右下の表示のように、文字コードが、「UTF-8」になっています。

本サイトに関連ある記事一覧

Follow me!

「二次元配列」を「CSVファイル」に出力。ダブルクォーテーション有無、Shift-JIS/UTF-8選択可能。” に対して2件のコメントがあります。

コメントを残す