VBA – CSV出力｜Yuu's Memo

Excel VBAを使ったCSVファイルの出力、データを新しい次元に引き上げる手段として非常に有用です。
今回は、不定の行数と列数に対応し、データの形式を考慮したCSV出力コードを紹介します。
この記事ではコードの動作から始め、その利点や改善点、活用方法まで丁寧に解説します。それでは、早速書いていきます！

実装

Sub myCSV()
    Dim myColumn As Range
    Dim myCell As Range
    Dim myLastCell As Range
    Dim myRow As Range
    Dim Fname As String
    Dim N As Integer
    Dim i As Integer
    
    ' 列を取得
    Set myColumn = ActiveSheet.UsedRange
    Set myColumn = myColumn.Columns(1)
    
    ' 出力先ファイルの設定
    Fname = ThisWorkbook.Path & "\Test.csv"
    N = FreeFile(0)
    Open Fname For Output As #N
    
    ' 列ごとに処理
    For Each myCell In myColumn.Cells
        With myCell
            ' 行の最後のセルを取得
            Set myLastCell = .EntireRow
            Set myLastCell = myLastCell.Cells(myLastCell.Cells.Count)
            Set myLastCell = myLastCell.End(xlToLeft)
            
            ' 行の範囲を取得
            If myLastCell.Column < myCell.Column Then
                Set myRow = myCell
            Else
                Set myRow = .Worksheet.Range(myCell, myLastCell)
            End If
        End With
        
        ' 行のデータをCSVに書き込む
        With myRow
            Print #N, .Cells(1).Value;
            For i = 2 To .Cells.Count
                Print #N, ","; .Cells(i).Value;
            Next
            Print #N, ""
        End With
    Next
    
    ' ファイルを閉じる
    Close #N
    
    ' 使用したオブジェクトの解放
    Set myColumn = Nothing
    Set myCell = Nothing
    Set myLastCell = Nothing
    Set myRow = Nothing
End Sub

このコードは、アクティブなシートの最初の列を基準にしてデータをCSV形式で出力します。それでは、各部分を詳しく見ていきましょう。

解説

Set myColumn = ActiveSheet.UsedRange
Set myColumn = myColumn.Columns(1)

myColumnはアクティブなシートの使用範囲から最初の列を取得しています。この列がCSVとして出力されます。

Fname = ThisWorkbook.Path & "\Test.csv"
N = FreeFile(0)
Open Fname For Output As #N

Fnameには出力先のファイルパスが格納され、Nはファイルナンバーです。FreeFile(0)は未使用のファイルナンバーを取得します。

For Each myCell In myColumn.Cells
    ' ...
Next

myColumn内の各セルに対して処理が行われます。

With myCell
    Set myLastCell = .EntireRow
    Set myLastCell = myLastCell.Cells(myLastCell.Cells.Count)
    Set myLastCell = myLastCell.End(xlToLeft)
    
    If myLastCell.Column < myCell.Column Then
        Set myRow = myCell
    Else
        Set myRow = .Worksheet.Range(myCell, myLastCell)
    End If
End With

各セルからその行の最後のセルと行の範囲を取得しています。これにより、行のデータを1行分取得できます。

With myRow
    Print #N, .Cells(1).Value;
    For i = 2 To .Cells.Count
        Print #N, ","; .Cells(i).Value;
    Next
    Print #N, ""
End With

取得した行のデータをCSV形式に整形してファイルに書き込みます。

Close #N

ファイルの書き込みが終わったら、ファイルを閉じます。

Set myColumn = Nothing
Set myCell = Nothing
Set myLastCell = Nothing
Set myRow = Nothing

コードの最後で使用したオブジェクトを解放しています。

利点

1. 不定な行数と列数に対応

このコードは不定な行数と列数に対応しています。使い勝手が非常に高く、様々な形式のデータにも柔軟に対応できます。

2. 直感的で理解しやすい

VBA初心者でも理解しやすい構造になっています。各行のコメントがわかりやすく、コードの流れも直感的です。

3. 柔軟性と再利用性

他のVBAプロシージャに組み込んで利用することが容易です。新しいプロシージャに組み込んだり、このプロシージャを拡張してより高度なCSV操作に応用することもできます。

改善案

1. エラーハンドリングの追加

エラーハンドリングを追加することで、予期せぬ問題が発生した際にプログラムがクラッシュするのを防げます。たとえば、ファイルのオープンに失敗した場合などに対処できるようにしましょう。

2. CSVのカンマ処理の改善

現在の実装では、データにカンマが含まれている場合に正確なCSVを生成できません。これを改善するためには、データに含まれるカンマをエスケープするなどの処理が必要です。

3. プロシージャの柔軟性向上

現在のプロシージャはアクティブなシートの最初の列を基準にデータを取得しています。柔軟性を向上させるために、ユーザが対象となるシートや列を指定できるようなオプションを追加すると良いでしょう。

改善サンプル

上記３点を簡単に組み込んだ例を紹介します。

Sub myCSV()
    Dim myColumn As Range
    Dim myCell As Range
    Dim myLastCell As Range
    Dim myRow As Range
    Dim Fname As String
    Dim N As Integer
    Dim i As Integer
    
    On Error GoTo ErrorHandler
    
    ' 列を取得
    Set myColumn = ActiveSheet.UsedRange
    Set myColumn = myColumn.Columns(1)
    
    ' 出力先ファイルの設定
    Fname = ThisWorkbook.Path & "\Test.csv"
    N = FreeFile(0)
    Open Fname For Output As #N
    
    ' 列ごとに処理
    For Each myCell In myColumn.Cells
        With myCell
            ' 行の最後のセルを取得
            Set myLastCell = .EntireRow
            Set myLastCell = myLastCell.Cells(myLastCell.Cells.Count)
            Set myLastCell = myLastCell.End(xlToLeft)
            
            ' 行の範囲を取得
            If myLastCell.Column < myCell.Column Then
                Set myRow = myCell
            Else
                Set myRow = .Worksheet.Range(myCell, myLastCell)
            End If
        End With
        
        ' 行のデータをCSVに書き込む
        With myRow
            Print #N, .Cells(1).Value;
            For i = 2 To .Cells.Count
                ' カンマ処理の改善
                If .Cells(i).Value Like "*,*" Then
                    Print #N, """" & .Cells(i).Value & """";
                Else
                    Print #N, .Cells(i).Value;
                End If
            Next
            Print #N, ""
        End With
    Next
    
    ' ファイルを閉じる
    Close #N
    
    ' 使用したオブジェクトの解放
    Set myColumn = Nothing
    Set myCell = Nothing
    Set myLastCell = Nothing
    Set myRow = Nothing
    
    Exit Sub ' エラーハンドリングのため、正常終了時に処理を終了する
    
ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    ' エラーが発生した場合でもファイルを閉じる
    If N <> 0 Then Close #N
    ' エラーハンドリング後のクリーンアップ
    Set myColumn = Nothing
    Set myCell = Nothing
    Set myLastCell = Nothing
    Set myRow = Nothing
End Sub

この修正では、以下の点が行われています。

エラーハンドリングを追加しました。On Error GoTo ErrorHandler により、エラーが発生した場合に ErrorHandler というラベルが指定された部分にジャンプします。エラーメッセージは Err.Description を用いて取得し、メッセージボックスで表示されます。
カンマ処理を改善しました。Like 演算子を使用してセルの値がカンマを含むかどうかをチェックし、含む場合はダブルクォーテーションで値を囲んで出力されるようにしました。
ファイルを閉じる部分がエラーハンドリングの中に移動し、エラーが発生した場合でもファイルが適切に閉じられるように修正しました。
正常終了時にもクリーンアップ処理が行われるように、プロシージャの最後に Exit Sub 文を追加しました。

上記コードは最低限の実装なので、更に改善する事が可能なので色々試してみて下さい。