- マクロでExcelのデータをCSVに書き出したい！
- なんだか処理が遅い気がする…
マクロで大量データを1セルずつ書き出すと、数千行を超えたあたりから明らかに動作が重くなります。
しかも、余計な処理が入るとファイルサイズが大きくなったり、開くのに時間がかかることも…。
そこで本記事では、配列を使って「高速かつ正しいCSV形式」で出力する方法を、VBA初心者の方向けにステップごとに解説します。
本記事を読み終えれば、数万行のデータも一瞬でCSVに書き出せるマクロを自作できるようになります。
完成コード
今回のマクロでは、次のようなことをしています。
Sheet1の「使用中のセル範囲（UsedRange）」を取得- 各セルをCSV向けに整形
- 指定したパスに
.csvファイルとして保存 - 保存時にエラーが発生したら、内容をわかりやすく表示
コードを読む際には、ExportUsedRangeToCSVを起点として考えるとわかりやすいです。
以下が結論のコードです。
Option Explicit
'===============================
' メイン処理
'===============================
Public Sub ExportUsedRangeToCSV()
On Error GoTo ErrorHandler
Dim dataArray As Variant
Dim outputPath As String
Dim fileNum As Integer
Dim i As Long
'--- 対象データを取得 ---
dataArray = GetSheetData("Sheet1")
'--- 出力ファイルパス ---
outputPath = ThisWorkbook.Path & "\output.csv"
'--- ファイルを開く ---
fileNum = FreeFile
Open outputPath For Output As #fileNum
'--- CSV形式で書き込み ---
For i = LBound(dataArray, 1) To UBound(dataArray, 1)
Print #fileNum, ArrayRowToCSVLine(dataArray, i)
Next i
'--- ファイルを閉じる ---
Close #fileNum
MsgBox "CSVファイルを出力しました。", vbInformation
Exit Sub
'--- エラー処理 ---
ErrorHandler:
MsgBox GetErrorMessage(Err.Number, Err.Description), vbCritical
On Error Resume Next
Close #fileNum
End Sub
'===============================
' シートから使用中範囲を配列取得
'===============================
Private Function GetSheetData(sheetName As String) As Variant
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(sheetName)
GetSheetData = ws.UsedRange.Value
End Function
'===============================
' 1セル分のCSV用エスケープ処理
'===============================
Private Function EscapeCSVValue(value As Variant) As String
Dim cellValue As String
cellValue = CStr(value)
' 囲むべき条件：カンマ、ダブルクォート、改行を含む場合
If InStr(cellValue, ",") > 0 _
Or InStr(cellValue, """") > 0 _
Or InStr(cellValue, vbCr) > 0 _
Or InStr(cellValue, vbLf) > 0 Then
cellValue = """" & Replace(cellValue, """", """""") & """"
End If
EscapeCSVValue = cellValue
End Function
'===============================
' 配列の1行をCSV文字列に変換
'===============================
Private Function ArrayRowToCSVLine(dataArray As Variant, rowIndex As Long) As String
Dim j As Long, line As String
For j = LBound(dataArray, 2) To UBound(dataArray, 2)
line = line & EscapeCSVValue(dataArray(rowIndex, j))
If j < UBound(dataArray, 2) Then line = line & ","
Next j
ArrayRowToCSVLine = line
End Function
'===============================
' エラーメッセージ生成
'===============================
Private Function GetErrorMessage(errNum As Long, errDesc As String) As String
Select Case errNum
Case 70: GetErrorMessage = "アクセス権限がありません。ファイルが開かれていないか確認してください。"
Case 75: GetErrorMessage = "ファイルパスが無効です。"
Case 76: GetErrorMessage = "指定されたパスが見つかりません。"
Case 6: GetErrorMessage = "ファイルサイズが大きすぎます。"
Case Else
GetErrorMessage = "予期せぬエラーが発生しました。" & vbCrLf & _
"番号: " & errNum & vbCrLf & _
"説明: " & errDesc
End Select
End Function上記のように、Private Functionとして関数に分けて読みやすく保守性を確保しました。
処理内容のまとまりごとに解説します。
対象シートのデータ取得
メイン処理では、以下のコードで表されます。
dataArray = GetSheetData("Sheet1")Sheet1の使用中セルを取得するコードです。
具体的なセル指定は、次のGetSheetData関数で表されています。
Private Function GetSheetData(sheetName As String) As Variant
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(sheetName)
GetSheetData = ws.UsedRange.Value
End FunctionUsedRange関数で「使用中のセル範囲」の値を配列として取得しています。
使用中のセル範囲とは、なんらかの値や書式、コメントが入っているセルです。
最終的にdataArray変数として、該当セルの値が配列として格納されるというわけです。
保存先ファイルパスを指定
CSVファイルの保存先パスを設定しています。
outputPath = ThisWorkbook.Path & "\output.csv"ThisWorkbook.Pathとすることで、現在のブックが存在するパスを取得できます。
\output.csvとすることでファイル名をoutput.csvに指定しています。
ファイルオープンと書き込み
VBAでは「ファイル番号」を使って開くファイルを識別します。
新規作成や既存ファイルの操作を行うには、FreeFile で未使用の番号を取得し、その番号を使ってOpenを使うと、新規作成または上書き保存されます。
次のようなコードになります。
fileNum = FreeFile
Open outputPath For Output As #fileNumoutputPathのところでは、一つ前のコードで保存するCSVファイルのパスを指定しています。
配列を1行ずつ変換して出力
配列として取得したセル範囲を一つずつ取り出して、CSVに書き込みます。
For i = LBound(dataArray, 1) To UBound(dataArray, 1)
Print #fileNum, ArrayRowToCSVLine(dataArray, i)
Next iこのコードの1行目では行を順番に処理しています。つまり、1行目、2行目…のように処理が進んでいきます。
そして、取り出した行に対してArrayRowToCSVLine関数を使っています。
いわば、これが列方向のループですね。
Private Function ArrayRowToCSVLine(dataArray As Variant, rowIndex As Long) As String
Dim j As Long, line As String
For j = LBound(dataArray, 2) To UBound(dataArray, 2)
line = line & EscapeCSVValue(dataArray(rowIndex, j))
If j < UBound(dataArray, 2) Then line = line & ","
Next j
ArrayRowToCSVLine = line
End Functionこの関数では、受け取った行の各セルに対してCSVのエスケープとカンマ区切りを加えています。
ここを通過することで、CSVとしての体裁が整うという感じです。
ファイルを閉じる＆メッセージ表示
最後にファイルを閉じて、結果を出力しましょう。
Close #fileNum
MsgBox "CSVファイルを出力しました。", vbInformationMsgBoxまで流れれば、このスクリプトは正常終了です。
エラー時は専用メッセージを表示
スクリプト中に何かエラーがあって中断した場合には、以下のコードが呼び出されます。
MsgBox GetErrorMessage(Err.Number, Err.Description), vbCritical具体的なエラー処理の内容はGetErrorMessage関数に記載の通りです。
エラーの種類の応じて、適切なメッセージを表示するようにしています。
コメント