Excelデータの特定箇所をCSV出力する
ExcelデータをCSVファイルにするには保存時にファイル形式を「CSV(ｺﾝﾏ区切り)(*.csv)ファイル」にすることで変換できますが、特定箇所のデータをCSV出力したり、データをダブルコーテーションで括ったりするにはVBAを使うと簡単にできます。今回はEXCEL上のボタンをワンクリックするだけで６項目のデータの中から３項目を抽出するCSV出力アプリを作成しましたのでご紹介します。
サンプルアプリ実行結果
下記赤丸箇所の「ＣＳＶファイル出力」ボタンをクリックすると６項目のデータの中から３項目（「No」「氏名」「通勤手当」）のデータがCSVファイル（YYYYMMDD-HHMMSS.csv）として作成されます。
サンプルコードの処理内容
サンプルアプリのコードの流れは以下の通りです。
まず保存先としてサンプルアプリがあるフォルダを指定します。
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
CSVテキスト項目に出力できない文字については、「CutChar」関数で除去しています。
X(col) = CutChar(ws.Cells(lngRow, col).Value)
サンプルコード アプリの作成手順はこちら
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 '１文字を格納する変数を定義
Dim strOutText As String '１文字ずつ結合した文字を格納する変数を定義
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