<概要>
今回は、二次元配列をテキスト形式で出力する汎用プロシージャを紹介します。
詳細は実行例を見ていただくほうが分かりやすいですが、計算結果などを二次元配列をまとめた状態で、外部ファイルとして出力するときに役立ちます。
外部ファイルはテキストファイル（txtファイル）だけでなく、CSVファイルやTSVファイルも設定可能です。
CSVファイルであれば二次元配列の各列をカンマ「,」区切り、TSVファイルであればTab（Chr(9)）区切りに設定すればよいです。
また、出力するファイルの文字エンコーディングはUTF-8、UTF-16、ShiftJISの3種類から選択可能です。
<用途>
計算結果などのテキストファイルの出力
CSV,TSVファイルなどの出力
<プロシージャ紹介>
Public Sub OutputText(Array2D, FolderPath As String, FileName As String, StringEncode As EnumStringEncode, [Delimiter As String = "",""])
名前： OutputText /Subプロシージャ
説明： 二次元配列をテキストファイルとして出力する
引数
Array2D ・・・出力する二次元配列
FolderPathh ・・・出力先フォルダパス
FileName ・・・出力ファイル名(拡張子を含めること)
StringEncode・・・出力する文字エンコーディング
[Delimiter] ・・・列方向の区切り文字(デフォルトは「,」)
<実行例>
ワークシート上に次のような値を準備します。
サンプルコードは次のようになります。
出力先のフォルダは「C:\Test」を指定していますので、こちらのフォルダも準備するか、既存のフォルダパスで置き換えてください。
Public Sub TestOutputText()
Dim Array2D As Variant: Array2D = Sheet1.Range("B2:D5").Value
Dim FolderPath As String: FolderPath = "C:\Test"
'カンマ「,」区切りで出力
Call OutputText(Array2D, FolderPath, "TestText_Comma.txt", vbUTF8, ",")
'タブ区切りで出力
Call OutputText(Array2D, FolderPath, "TestText_Tab.txt", vbUTF8, Chr(9))
'カンマ「,」区切りでCSVファイルとして出力
Call OutputText(Array2D, FolderPath, "TestCSV.csv", vbUTF8, ",")
'タブ区切りでTSVファイルとして出力
Call OutputText(Array2D, FolderPath, "TestTSV.tsv", vbUTF8, Chr(9))
End Sub出力先のフォルダには「TestText_Comma.txt」「TestText_Tab.txt」「TestCSV.csv」「TestTSV.tsv」が出力されています。
<サンプルファイル>
<コード>
'OutputText ・・・元場所：VBAProject.Mod01_
'OutputTextUTF ・・・元場所：VBAProject.Mod01_
'ConvArray2DtoText ・・・元場所：VBAProject.Mod01_
'OutputTextShiftJIS・・・元場所：VBAProject.Mod01_
'宣言セクション※※※※※※※※※※※※※※※※※※※※※※※※※※※
'-----------------------------------
'元場所:VBAProject.Mod01_.EnumStringEncode
Public Enum EnumStringEncode
vbUTF8
vbUTF16
vbShiftJIS
End Enum
'宣言セクション終了※※※※※※※※※※※※※※※※※※※※※※※※※※※
Public Sub OutputText(ByRef Array2D As Variant, _
ByRef FolderPath As String, _
ByRef FileName As String, _
ByRef StringEncode As EnumStringEncode, _
Optional ByRef Delimiter As String = ",")
'二次元配列をテキストファイルとして出力する
'20231218
'参考
'https://www.softex-celware.com/post/outputtext
'引数
'Array2D ・・・出力する二次元配列
'FolderPathh ・・・出力先フォルダパス
'FileName ・・・出力ファイル名(拡張子を含めること)
'StringEncode・・・出力する文字エンコーディング
'[Delimiter] ・・・列方向の区切り文字(デフォルトは「,」)
'処理
Select Case StringEncode
Case vbUTF8
Call OutputTextUTF(Array2D, FolderPath, _
FileName, Delimiter, "utf-8")
Case vbUTF16
Call OutputTextUTF(Array2D, FolderPath, _
FileName, Delimiter, "utf-16")
Case vbShiftJIS
Call OutputTextShiftJIS(Array2D, FolderPath, _
FileName, Delimiter)
End Select
End Sub
Private Sub OutputTextUTF(ByRef Array2D As Variant, _
ByRef FolderPath As String, _
ByRef FileName As String, _
ByRef Delimiter As String, _
ByRef UTF As String)
'二次元配列をテキストファイルで出力する
'UTF-8形式、UTF-16形式で出力する
'引数
'Array2D ・・・出力する二次元配列
'FolderPath・・・出力先フォルダパス
'FileName ・・・出力ファイル名(拡張子を含めること)
'Delimiter ・・・列方向の区切り文字
'UTF ・・・UTF形式(UTF-8かUTF-16)
'処理
Dim Text As String: Text = ConvArray2DtoText(Array2D, Delimiter)
Dim stream As Object: Set stream = CreateObject("ADODB.Stream")
stream.Type = 2 ' テキストファイル
stream.Charset = UTF
stream.Open
stream.WriteText Text
stream.SaveToFile FolderPath & "\" & FileName, 2 '2は上書き
stream.Close
End Sub
Private Function ConvArray2DtoText(ByRef Array2D As Variant, _
ByRef Delimiter As String) _
As String
'テキスト出力用に二次元配列を文字列に変換する
'処理
'出力するテキスト（文字列）を作成
Dim I As Long
Dim J As Long
Dim N As Long: N = UBound(Array2D, 1)
Dim M As Long: M = UBound(Array2D, 2)
Dim Text As String: Text = ""
For I = 1 To N
For J = 1 To M
If J = 1 Then
Text = Text & Array2D(I, J)
ElseIf J < M Then
Text = Text & Delimiter & Array2D(I, J)
Else
If I < N Then
Text = Text & Delimiter & Array2D(I, J) & vbCrLf
Else
'最後は改行しない
Text = Text & Delimiter & Array2D(I, J)
End If
End If
Next
Next
'出力
ConvArray2DtoText = Text
End Function
Private Sub OutputTextShiftJIS(ByRef Array2D As Variant, _
ByRef FolderPath As String, _
ByRef FileName As String, _
ByRef Delimiter As String)
'二次元配列をテキストファイルで出力する
'ShiftJIS形式で出力する
'引数
'Array2D ・・・出力する二次元配列
'FolderPath・・・出力先フォルダパス
'FileName ・・・出力ファイル名(拡張子を含めること)
'Delimiter ・・・列方向の区切り文字
'処理
Dim Text As String: Text = ConvArray2DtoText(Array2D, Delimiter)
Open FolderPath & "\" & FileName For Output As #1
Print #1, Text
Close #1
End Sub
Comments