VBAでCSVに落とす方法

投稿日: 2024年6月20日

VBAでデータをCSVファイルに落とす(書き出す)方法を説明します。
CSVとはCSV（Comma-Separated Values）は、データをテキスト形式で保存するファイル形式の一つです。

CSVの特徴

  1. 簡単な構造：データはカンマで区切られたテキスト形式で保存されるため、人間にも読みやすく、編集が容易です。
  2. 互換性：多くのアプリケーションやプログラミング言語でサポートされており、データのやり取りに便利です。例えば、Excel、Googleスプレッドシート、Pythonなどで簡単に読み書きできます。
  3. 汎用性：データベース、スプレッドシート、統計ソフトウェアなど、さまざまなツールでのデータのインポートやエクスポートに使用されます。

CSVに落とす

参考データをExcelのsheet1に貼り付けてください。

名前年齢性別職業
山田太郎30男エンジニア
佐藤花子25女デザイナー
参考次郎20男タレント

CSVに落とすコード

Sub ExportToCSV()
    Dim ws As Worksheet
    Dim csvFilePath As String
    Dim csvFile As Object
    Dim row As Long
    Dim col As Long
    Dim lastRow As Long
    Dim lastCol As Long
    Dim line As String
    
    ' "Sheet1" を設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' CSVファイルのパスを指定
    csvFilePath = "C:\path\to\your\folder\export.csv"
    
    ' FileSystemObjectの作成
    Set csvFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(csvFilePath, True, False)
    
    ' 最終行と最終列を取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' データをCSVファイルに書き出し
    For row = 1 To lastRow
        line = ""
        For col = 1 To lastCol
            line = line & ws.Cells(row, col).Value
            If col < lastCol Then
                line = line & ","
            End If
        Next col
        csvFile.WriteLine line
    Next row
    
    ' ファイルを閉じる
    csvFile.Close
    
    ' メッセージボックスで完了を通知
    MsgBox "CSVファイルの書き出しが完了しました: " & csvFilePath
End Sub

CSVファイルのパス指定「csvFilePath」 で書き出すCSVファイルのパスを指定します。パスは適宜変更してください。
FileSystemObjectの作成「 CreateObject(“Scripting.FileSystemObject”).CreateTextFile(csvFilePath, True, False)」でCSVファイルを作成します。
ループを使用して各セルのデータを読み込み、「For col = 1 To lastCol」でカンマで区切ってCSVファイルに書き出します。

このコードを実行すると、アクティブシートの内容が指定したパスにCSVファイルとして書き出されます。パスやファイル名、シートの範囲などは必要に応じて変更してください。

指定する列だけをCSVに保存する

指定するフィールド名（列名）だけを抜き出してCSVに書き出す方法について説明します。

Sub ExportSelectedFieldsToCSV()
    Dim ws As Worksheet
    Dim csvFilePath As String
    Dim csvFile As Object
    Dim row As Long
    Dim col As Variant
    Dim lastRow As Long
    Dim lastCol As Long
    Dim line As String
    Dim fieldNames As Variant
    Dim fieldColumns As Collection
    Dim fieldName As Variant
    Dim i As Long
    
    ' "Sheet1" を設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' 書き出すフィールド名を指定
    fieldNames = Array("名前", "年齢", "職業")
    
    ' フィールド名に対応する列インデックスを格納するコレクションを作成
    Set fieldColumns = New Collection
    
    ' CSVファイルのパスを指定
    csvFilePath = "C:\path\to\your\folder\export.csv"
    
    ' FileSystemObjectの作成
    Set csvFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(csvFilePath, True, False)
    
    ' 最終行と最終列を取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' フィールド名に対応する列インデックスを特定
    For i = 1 To lastCol
        For Each fieldName In fieldNames
            If ws.Cells(1, i).Value = fieldName Then
                fieldColumns.Add i
            End If
        Next fieldName
    Next i
    
    ' 指定フィールド名のデータをCSVファイルに書き出し
    For row = 1 To lastRow
        line = ""
        For Each col In fieldColumns
            line = line & ws.Cells(row, col).Value
            If col <> fieldColumns.Item(fieldColumns.Count) Then
                line = line & ","
            End If
        Next col
        csvFile.WriteLine line
    Next row
    
    ' ファイルを閉じる
    csvFile.Close
    
    ' オブジェクトの解放
    Set fieldColumns = Nothing
    Set csvFile = Nothing
    
    ' メッセージボックスで完了を通知
    MsgBox "指定フィールドのCSVファイルの書き出しが完了しました: " & csvFilePath
End Sub

フィールド名を指定を「fieldNames」で 配列で書き出したいフィールド名（列名）を指定します。ここでは「Array(“名前”, “年齢”, “職業”)」の3つを設定しています。
「Set fieldColumns = New Collection」でコレクションにフィールド名に対応する列のインデックスを格納します。
「csvFilePath = “C:\path\to\your\folder\export.csv”」で書き出すCSVファイルのパスを指定します。このパスとCSVの保存名は適宜変更してください。
FileSystemObjectの作成:で「CreateObject(“Scripting.FileSystemObject”).CreateTextFile(csvFilePath, True, False)」でCSVファイルを作成します。

フィールド名に対応する列インデックスを特定でシートの1行目（ヘッダー行）をループして、指定したフィールド名に一致する列のインデックスを 「fieldColumns」コレクションに追加します。
指定フィールド名のデータをCSVファイルに書き出しで「fieldColumns」 コレクションを使用して、指定されたフィールドのデータをCSVファイルに書き出します。
ここの処理で指定されていないフィールド名を取得しないようにしています。

誰かが開いている場合の回避方法

ファイルが他のユーザーによって開かれている場合、エラーで処理がとまります。回避方法として、エラーハンドリングを使用することができます。

Sub ExportSelectedFieldsToCSV()
    Dim ws As Worksheet
    Dim csvFilePath As String
    Dim csvFile As Object
    Dim row As Long
    Dim col As Variant
    Dim lastRow As Long
    Dim lastCol As Long
    Dim line As String
    Dim fieldNames As Variant
    Dim fieldColumns As Collection
    Dim fieldName As Variant
    Dim i As Long
    
    ' "Sheet1" を設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' 書き出すフィールド名を指定
    fieldNames = Array("名前", "年齢", "職業")
    
    ' フィールド名に対応する列インデックスを格納するコレクションを作成
    Set fieldColumns = New Collection
    
    ' CSVファイルのパスを指定
    csvFilePath = "C:\path\to\your\folder\export.csv"

    ' エラーハンドリングの開始
    On Error GoTo ErrorHandler

    ' FileSystemObjectの作成
    Set csvFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(csvFilePath, True, False)
    
    ' 最終行と最終列を取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' フィールド名に対応する列インデックスを特定
    For i = 1 To lastCol
        For Each fieldName In fieldNames
            If ws.Cells(1, i).Value = fieldName Then
                fieldColumns.Add i
            End If
        Next fieldName
    Next i
    
    ' 指定フィールド名のデータをCSVファイルに書き出し
    For row = 1 To lastRow
        line = ""
        For Each col In fieldColumns
            line = line & ws.Cells(row, col).Value
            If col <> fieldColumns.Item(fieldColumns.Count) Then
                line = line & ","
            End If
        Next col
        csvFile.WriteLine line
    Next row
    
    ' ファイルを閉じる
    csvFile.Close
    
    ' オブジェクトの解放
    Set fieldColumns = Nothing
    Set csvFile = Nothing
    
    ' メッセージボックスで完了を通知
    MsgBox "指定フィールドのCSVファイルの書き出しが完了しました: " & csvFilePath
ErrorHandler:
    MsgBox "ファイルの書き出し中にエラーが発生しました。ファイルが他のユーザーによって開かれている可能性があります。", vbExclamation
    ' 必要に応じてエラー処理を追加
End Sub

エラーハンドリングの開始「On Error GoTo ErrorHandler」でエラーが発生した場合に ErrorHandler ラベルにジャンプするようにします。
エラーハンドラーの追加「ErrorHandler」ラベルでエラーメッセージを表示し、必要に応じてエラー処理を追加します。

この修正により、ファイルが他のユーザーによって開かれている場合やその他のエラーが発生した場合に、適切なエラーメッセージを表示することができます。
必要に応じて、エラーハンドラー内で追加の処理（例えば、再試行のオプションをユーザーに提示するなど）を行うことも可能です。

csvのファイル名にファイル名+日付を追加

CSVファイル名にファイル名と日付を追加する方法を以下に示します。

Sub ExportSelectedFieldsToCSV()
    Dim ws As Worksheet
    Dim csvFilePath As String
    Dim csvFileName As String
    Dim csvFile As Object
    Dim row As Long
    Dim col As Variant
    Dim lastRow As Long
    Dim lastCol As Long
    Dim line As String
    Dim fieldNames As Variant
    Dim fieldColumns As Collection
    Dim fieldName As Variant
    Dim i As Long
    Dim dateSuffix As String
    
    ' "Sheet1" を設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' 書き出すフィールド名を指定
    fieldNames = Array("名前", "年齢", "職業")
    
    ' フィールド名に対応する列インデックスを格納するコレクションを作成
    Set fieldColumns = New Collection
    
    ' 日付をフォーマットして取得
    dateSuffix = Format(Now, "yyyymmdd")
    
    ' CSVファイルの名前を指定（元のファイル名に日付を追加）
    csvFileName = "export_" & dateSuffix & ".csv"
    
    ' CSVファイルのパスを指定
    csvFilePath = "C:\path\to\your\folder\" & csvFileName
    
    ' エラーハンドリングの開始
    On Error GoTo ErrorHandler
    
    ' FileSystemObjectの作成
    Set csvFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(csvFilePath, True, False)
    
    ' 最終行と最終列を取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' フィールド名に対応する列インデックスを特定
    For i = 1 To lastCol
        For Each fieldName In fieldNames
            If ws.Cells(1, i).Value = fieldName Then
                fieldColumns.Add i
            End If
        Next fieldName
    Next i
    
    ' 指定フィールド名のデータをCSVファイルに書き出し
    For row = 1 To lastRow
        line = ""
        For Each col In fieldColumns
            line = line & ws.Cells(row, col).Value
            If col <> fieldColumns.Item(fieldColumns.Count) Then
                line = line & ","
            End If
        Next col
        csvFile.WriteLine line
    Next row
    
    ' ファイルを閉じる
    csvFile.Close
    
    ' オブジェクトの解放
    Set fieldColumns = Nothing
    Set csvFile = Nothing
    
    ' メッセージボックスで完了を通知
    MsgBox "指定フィールドのCSVファイルの書き出しが完了しました: " & csvFilePath
    Exit Sub

ErrorHandler:
    MsgBox "ファイルの書き出し中にエラーが発生しました。ファイルが他のユーザーによって開かれている可能性があります。", vbExclamation
    ' 必要に応じてエラー処理を追加
End Sub

日付のフォーマット「dateSuffix = Format(Now, “yyyymmdd”)」で現在の日付を「yyyymmdd」形式にフォーマットして取得します。
CSVファイル名の指定「csvFileName = “export_” & dateSuffix & “.csv”」 でファイル名に日付を追加します。
CSVファイルのパスを指定「csvFilePath = “C:\path\to\your\folder\” & csvFileName」でファイル名に日付を追加したフルパスを指定します。

このコードを実行すると、指定されたフィールド名のデータのみが日付付きのファイル名として指定したパスにCSVファイルとして書き出されます。フィールド名、パス、およびファイル名などは必要に応じて変更してください。

記事