Excelデータの特定箇所をCSV出力する

2022年4月17日

ExcelデータをCSVファイルに変換するには保存時にファイル形式を「CSV(コンマ区切り)(*.csv)ファイル」を選択すればできますが、Excelデータの特定箇所をCSV出力したり、データをダブルコーテーションで括ったりするにはVBAを使うと簡単にできます。
今回はExcelシートに作成した「CSVファイル出力」ボタンをクリックするとExcel上にある6項目のデータの中から3項目だけCSVデータを出力するアプリを作成しましたのでご紹介します。

サンプルアプリ実行結果

以下の手順でCSVファイルを出力します。
「CSVファイル出力」ボタンをクリックすると6項目のデータの中から3項目(「No」「氏名」「通勤手当」)のデータがCSVファイル(YYYYMMDD-HHMMSS.csv)として作成されます。

 —— YYYYMMDD-HHMMSS.csv —————
“No","名前","通勤手当"
“001","佐藤太郎","5200″
“002","小林花子","12100″
“003","佐々木一郎","6500″
“004","伊藤三郎","8500″
“005","鈴木二郎","9700″
“006","斎藤一郎","8500″
“007","吉田康生","6000″
“008","田中太郎","13200″
“009","山本太郎","7500″
“010","佐々木太郎","3500″
“011","山田太郎","4300″
“012","遠藤一郎","9600″
“013","高橋直美","7800″
“014","中村幸助","6000″
“015","加藤紘一","11500″
 —————————————————

サンプルコードの処理内容

サンプルアプリのコードの流れは以下の通りです。
まず保存先としてサンプルアプリがあるフォルダを指定します。

With ActiveWorkbook
xPath = .Path & “\"
End With


ファイル名に出力日の日時(yyyymmdd-hhnnss)を設定します。

Dim strDate As String
strDate = Format(Now, “yyyymmdd-hhnnss")


csvファイルの出力先とファイル名を指定します。

varFileName = xPath & strDate & “.csv"

指定ファイルをOpen(出力モード)にします。
#FileNumberはOpenステートメントで指定したファイル番号です。

Open varFileName For Output As #FileNumber

データをCSV形式で出力します。
Write # ステートメントを使うと文字列がダブルクォーテーションで括られます。
Print # ステートメントはデータがそのまま出力されます。
今回はWrite # ステートメントを利用します。
X(2), X(3), X(7)はCSVとして出力するExcelデータの2列目、3列目、7列目を指定しています。

Write #FileNumber, X(2), X(3), X(7)

出力したCSVファイルを閉じます。

Close #FileNumber

サンプルコード  アプリの作成手順はこちら

Option Explicit

Sub Export_CSVFile()

 Const cnsTitle = "CSVファイル出力" '「名前を付けて保存」ダイアログのタイトル
 
 Dim xlAPP As Application  'Excel.Applicationオブジェクトの定義
 Dim varFileName As String '出力先ファイル名の変数定義
 Dim X(1 To 7) As Variant  '書き出すレコード内容のリスト変数を定義
 Dim lngRow As Long        '処理データ行の変数定義
 Dim rowLast As Long       'データ最終行の変数定義
 Dim col As Long           'カラム変数の定義
 Dim xPath As String       '出力先パス変数の定義
 Dim FileNumber

 Dim ws As Worksheet
 Set ws = Worksheets("Sheet1")  '***********************************************
  
 'Applicationオブジェクト取得
 Set xlAPP = Application
 
 '保存先パスの設定
 With ActiveWorkbook
  xPath = .Path & "\"  'アンプルアプリがあるフォルダを指定
 End With
 
 '現在日時をファイル名のデフォルト値に指定
 Dim strDate As String
 strDate = Format(Now, "yyyymmdd-hhnnss")
 
 'データ(B列)最終行を取得
 rowLast = ws.Cells(Rows.Count, 2).End(xlUp).Row

 'タイトル行を含め2行に満たない場合は出力しない
 If rowLast < 2 Then
   xlAPP.StatusBar = False
   MsgBox "出力出来るデータがありません。", , cnsTitle
   Exit Sub
 End If

 'csv出力先とファイル名を指定
 varFileName = xPath & strDate & ".csv"
    
 '使用可能なファイル番号を取得
 FileNumber = FreeFile

 '指定ファイルをOpen(出力モード)にする
 Open varFileName For Output As #FileNumber

 '開始行を指定
 lngRow = 5

 '最終行まで繰り返す
 Do Until lngRow > rowLast
      
   '配列Xの再初期化
   Erase X
   
   'B~G列内容をレコードにセット(先頭は1行目)
   For col = 2 To 7
   
    'CSVテキスト項目に出力できない文字を除去する(下記「CutChar」関数参照)
    X(col) = CutChar(ws.Cells(lngRow, col).Value)
    
   Next col
  
   'レコードを出力
   'Write # ステートメントは文字列がダブルクォーテーションで括られる
   Write #FileNumber, X(2), X(3), X(7)

   'データ処理件数をカウント
   lngRow = lngRow + 1
   xlAPP.StatusBar = "出力中です....(" & lngRow - 1 & "レコード目)"
 
 Loop
 
 '出力したCSVファイルを閉じる
 Close #FileNumber
 
 'ステータスバーの文字を非表示にする
 xlAPP.StatusBar = False
 
 '終了メッセージ
 MsgBox "CSV出力が完了しました。" & vbCr & _
  "レコード件数=" & lngRow - 6 & "件", vbInformation, cnsTitle
  
End Sub


'-----------------------------------------------------------------

'CSVテキスト項目に出力できない文字を除去する関数
Private Function CutChar(varInText As Variant) As Variant
 Dim strInText As String  'テキストを格納する変数を定義
 Dim POS As Long          '文字列の桁数を格納する変数を定義
 Dim strChar As String    '1文字を格納する変数を定義
 Dim strOutText As String '1文字ずつ結合した文字を格納する変数を定義
    
 CutChar = Empty
 
 '一旦、文字列に変換する
 strInText = Trim$(CStr(varInText))
 
 'ブランクの場合は処理なし
 If strInText = "" Then Exit Function
    
 '文字列の桁数分を繰り返す
 strOutText = ""
 For POS = 1 To Len(strInText)
 
  '1文字を取り出す
  strChar = Mid(strInText, POS, 1)
  
  '改行コードとダブルクォーテーションを省く
  If ((strChar <> vbCr) And (strChar <> """")) Then
  
   '取り出した文字を結合する
   strOutText = strOutText & strChar
   
  End If
  
 Next POS
 
 '改行コードとダブルクォーテーションを省いた文字列を返す
 CutChar = strOutText
 
End Function