エクセルのVBAでアクティブなシートのデータをCSVファイルに書き込む汎用的な関数を作ってみました。
writeCSVwithSingleQuotation1関数は、’で囲んで、カンマで区切って、セルの生データをCSVファイルに保存するの関数です。
writeCSVwithSingleQuotation2関数は、’で囲んで、カンマで区切って、セルの書籍設定が効いた表示データをCSVファイルに保存するの関数です。
writeCSVwithDoubleQuotation1関数は、”で囲んで、カンマで区切って、セルの生データをCSVファイルに保存するの関数です。
writeCSVwithDoubleQuotation2関数は、”で囲んで、カンマで区切って、セルの書籍設定が効いた表示データをCSVファイルに保存するの関数です。
writeCSVwithNoQuotation1関数は、カンマで区切るだけで、セルの生データをCSVファイルに保存するの関数です。
writeCSVwithNoQuotation2関数は、カンマで区切るだけで、セルの書籍設定が効いた表示データをCSVファイルに保存するの関数です。
writeCSV関数は各関数から呼び出されて、CSVファイルに書き込むメインの処理の関数です。
ファイル名と保存先のパスは各関数で希望するものに変更してください。
なお、保存したいシートをアクティブにして、保存したい表の中のいずれかのセルを選択した状態で、マクロから呼び出してください。
Macでの注意
Macでは、エクセルファイルをOneDriveから、ローカルのMacにコピーしてから使用してください。
また、CSVファイルの名前の前にある¥記号を/(スラッシュ)に変更してみてください。
それでうまく動かない時は報告していただけると助かります。
Option Explicit Public Sub writeCSVwithSingleQuotation1() Dim filePath As String filePath = ThisWorkbook.Path & "\sample01.csv" writeCSV filePath, "'", True End Sub Public Sub writeCSVwithSingleQuotation2() Dim filePath As String filePath = ThisWorkbook.Path & "\sample01.csv" writeCSV filePath, "'", False End Sub Public Sub writeCSVwithDoubleQuotation1() Dim filePath As String filePath = ThisWorkbook.Path & "\sample01.csv" writeCSV filePath, """", True End Sub Public Sub writeCSVwithDoubleQuotation2() Dim filePath As String filePath = ThisWorkbook.Path & "\sample01.csv" writeCSV filePath, """", False End Sub Public Sub writeCSVwithNoQuotation1() Dim filePath As String filePath = ThisWorkbook.Path & "\sample01.csv" writeCSV filePath, "", True End Sub Public Sub writeCSVwithNoQuotation2() Dim filePath As String filePath = ThisWorkbook.Path & "\sample01.csv" writeCSV filePath, "", False End Sub 'メインの処理用関数 Private Sub writeCSV(ByVal fileName As String, ByVal quote As String, ByVal rawData As Boolean) Dim fileNum As Integer Dim buf As String '最初にアクティブだったシート Dim ws As Worksheet 'データがあると思われるセル範囲 Dim dataRange As Range Dim rowStart As Integer Dim rowEnd As Integer Dim colStart As Integer Dim colEnd As Integer Dim strQuote As String 'ワークシートの行番号 Dim i As Integer Dim j As Integer If fileName = "" Then Exit Sub End If '最初にアクティブなシートにデータがあるとしてシートを記憶しておく Set ws = ActiveSheet 'データ範囲を自動認識 Set dataRange = ActiveCell.CurrentRegion 'データ範囲をFORループで処理するために行番号と列番号の範囲を取得しておく rowStart = dataRange.row rowEnd = rowStart + dataRange.Rows.Count - 1 colStart = dataRange.Column colEnd = colStart + dataRange.Columns.Count - 1 'データの間のカンマ等を作っておく strQuote = quote & "," & quote '空いているファイル番号を取得 fileNum = FreeFile '書き込みでファイルを開く Open fileName For Output As #fileNum For i = rowStart To rowEnd '各行の先頭のクォテーションを入れて置く buf = quote 'CSVファイルに書き込む For j = colStart To colEnd '生データを書き込むか、書式設定が効いた表示されているデータで書き込むかで分岐 If rawData = True Then If quote = """" Then buf = buf & Replace(ws.Cells(i, j).Value, """", """""") Else buf = buf & ws.Cells(i, j).Value End If Else If quote = """" Then buf = buf & Replace(ws.Cells(i, j).Text, """", """""") Else buf = buf & ws.Cells(i, j).Text End If End If '1行の最後のデータでなければデータ間を入れて置く If j <> colEnd Then buf = buf & strQuote End If Next j buf = buf & quote '1行を書き込む Print #fileNum, buf Next i Close #fileNum '変数の開放 Set dataRange = Nothing Set ws = Nothing End Sub