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