ExcelVBAを使ったCSVファイルへの書き込み

今回はVBAを使用したCSVファイル（メモ帳）への一括書き込み方法について備忘録的に紹介していきたいと思います。いわゆるCSV出力です。

今回の流れ
使用するファイルの解説
フォルダの確認
書き込み後のテキストファイル
コード解説
1. Openステートメント
  1. 番号
Dir関数
配列
表示形式の変更
1. Format関数
2. ダブルクォーテーション
文字化け対策
まとめ

今回の流れ

同じフォルダ内に複数のエクセルファイルがある
それらのエクセルファイルを列ごとに形式を変換する　（例）○年○月○日→〇/〇/〇
形式を変換した上で複数エクセルデータをCSVファイル（メモ帳）へ書き込んでいく（統合）

使用するファイルの解説

CSVファイルに書き込みするのに使用するエクセルファイルは、エクセルの神髄のVBA100本ノック43本目より引用させていただきます。

100本ノックの問題をほぼ踏襲しますが、以下のように形式を変換（制御）します。

A列：○○年○○月○○日

B列：カンマ無し整数

C列：少数1位まで表示

D列：文字列（適宜ダブルクォーテーションで囲む）

※ダブルクォーテーションで囲む意味：要素内に改行やカンマが含まれていると、例えばCSV（メモ帳）をExcelで開くと別々の要素だと認識されてそれぞれ違うセルに要素が振り分けられます。よって、ダブルクォーテーションで囲んで１つの要素だと認識させます（1要素の文字列と認識させる）。

フォルダの確認

上記、エクセルファイルVBA100_43(1)～（３）を「書き込み」テキストファイルに一括書き込みしていきます。※ファイルを（１）～（３）と分けて、日付を10日ごとに保存しています。

書き込みコードについては、マクロ.xlsmにあります。

書き込み後のテキストファイル

コード解説

Sub 書込み()
    Dim intFree As Integer
    Dim File As String
    Dim flag As Boolean
    
    Application.ScreenUpdating = False
    
    File = Dir(ThisWorkbook.Path & "\" & "*.xlsx", vbNormal)
    
    intFree = FreeFile
    
    flag = True
    Do While File <> ""
    
      Open ThisWorkbook.Path & "\書き込み.txt" For Append As intFree
      Workbooks.Open ThisWorkbook.Path & "\" & File
      
      Dim ary, i As Long
      ary = ActiveSheet.Range("A1").CurrentRegion
      If flag Then
        Print #1, Join(Array(ary(1, 1), ary(1, 2), ary(1, 3), ary(1, 4)), ",")
      End If
      
      For i = LBound(ary, 1) + 1 To UBound(ary, 1)
          Print #1, Format(ary(i, 1), "ggge年mm月dd日") & "," & _
                    Format(ary(i, 2), "0") & "," & _
                    Format(ary(i, 3), "0.0") & "," & _
                    """" & Replace(ary(i, 4), """", """""") & """"
      Next
      Close intFree
      Workbooks(File).Close False
      flag = False
      File = Dir()
    Loop
End Sub

Openステートメント

Open ThisWorkbook.Path & "\書き込み.txt" For Append As intFree

①【出力モード】　Open　ファイル名　For Output As　番号　　

①について、ファイル名（フルパス）にデータを書き込みます。ファイルが存在しない場合、書き込む際に新しいファイルが自動的に作成されます。既存のファイルを指定した場合、既に保存しているファイルの中のデータは消えてしまいます。

②【追記モード】　Open　ファイル名　For Append As　番号

②についても、ファイル名（フルパス）にデータを書き込みます。ファイルが存在しない場合、書き込む際に新しいファイルが自動的に作成されます。既存ファイルに書き込む場合、ファイルの中にデータがあれば、新たに読み込んだデータは既存データの末尾に追記されます。つまり既存データは消えません。今回は、データを追記するので、こちらを使用しました。

番号

FreeFile関数・・ファイル番号に使用されていない番号を自動的に返す。

intFree変数に格納されているFreeFile関数ですが、Openステートメントは必ず書き込みファイルに番号を割り当てるルールとなっています。FreeFile関数を使用することで、ファイル名の重複を避けることができます。

Dir関数

File = Dir(ThisWorkbook.Path & "\" & "*.xlsx", vbNormal)

こちらについては過去記事に解説があります。

配列

ary = ActiveSheet.Range("A1").CurrentRegion
      If flag Then
        Print #1, Join(Array(ary(1, 1), ary(1, 2), ary(1, 3), ary(1, 4)), ",")
      End If

ary変数に、エクセルファイルのデータを配列で格納しています。

下記はローカルウィンドウで見た、ary変数の中身です。

そして、Join関数で配列をカンマ区切りで結合しています。

結合したデータは、printステートメントで書き込んでいます。ここでの＃1は現在書き込もうとしているテキストファイルを指しています。一旦、タイトル行だけを書き込んでいます。

表示形式の変更

For i = LBound(ary, 1) + 1 To UBound(ary, 1)
          Print #1, Format(ary(i, 1), "ggge年mm月dd日") & "," & _
                    Format(ary(i, 2), "0") & "," & _
                    Format(ary(i, 3), "0.0") & "," & _
                    """" & Replace(ary(i, 4), """", """""") & """"
Next

For i = LBound(ary, 1) + 1 To UBound(ary, 1)については、LBoundは配列の最小値を取得します。UBoundは配列の最大値を取得します。

プラス１になっているのは、先ほど、タイトル行は書き込み済なので、2行目（配列の２番目）という意味です。