VBA Stepup13
第13章 CSVファイル取込サンプル
CSVデータを取込、CSVデータの項目から他のブックにあるデータを付加して、編集した新しいブックに名前を付けて保存する、という一連の処理をVBAで作成すると、この章のようなソースコードになります。CSVデータは、ETCの利用明細のフォーマットで、カード番号に対応した所属や氏名を付加します。
'変数の定義
Dim varFileName As Variant
Dim txtArray As Variant
Dim intFree As Integer
Dim strRec As String
Dim wb As Workbook
Dim ws As Worksheet
Dim nwb As Workbook
Dim nws As Worksheet
Dim CurrentPath As String
Dim saveName As String
Dim i As Long, j As Long, k As Long, l As Long
'ファイルを開くのダイアログを表示し、CSVファイルを選択させる
varFileName = Application.GetOpenFilename(_
FileFilter:="テキストファイル(*.csv),*.csv", _
Title:="CSVファイルの選択")
'CSVファイルが選択されていない場合は、処理を中断する
If varFileName = False Then
Exit Sub
End If
'CSVファイルをExcelで読み込み可能状態にする
intFree = FreeFile '空番号を取得
Open varFileName For Input As #intFree 'テキストファィルをオープン
'編集後のExcelファイルを保存するときの、ファイルのパスを取得する（マクロを実行しているファイルのパス）
CurrentPath = ThisWorkbook.Path
'オブジェクト変数wbに、ブック名ETCxxxxx.xlsxをセットする
Set wb = Workbooks.Open(Filename:=CurrentPath & _
"\ETCxxxxx.xlsx")
'オブジェクト変数wsに、ブック名「ETCxxxxx.xlsx」のシート名の「カード利用者」をセットする
Set ws = wb.Worksheets("カード利用者")
'オブジェクト変数nwbに、新規ブックをセットする
Set nwb = Workbooks.Add
'オブジェクト変数nwsに、新規ブックの一番左のシートをセットする
Set nws = nwb.Worksheets(1)
i = 1
'CSVファイルのテキストデータを1行ずつ読み込み、テキストデータが終わるまで繰り返す
Do Until EOF(intFree)
Line Input #intFree, strRec '1行読み込み
'CSVデータの1行分をカンマで分割して、配列の変数に代入する
txtArray = Split(strRec, ",")
'1行目はタイトル行なので、必要な項目を配列からセルに代入する
If i = 1 Then
nws.Cells(i, 1) = txtArray(1)
nws.Cells(i, 1).HorizontalAlignment = xlCenter
'1行目の2列目から5列目まではETCカード.xlsxのカード利用者のシートの1行目から項目名を代入する
For j = 2 To 5
nws.Cells(i, j) = ws.Cells(1, j)
nws.Cells(i, j).HorizontalAlignment = xlCenter
Next
nws.Cells(i, 6) = txtArray(3)
For j = 7 To 12
If j > 10 Then
nws.Cells(i, j) = txtArray(j - 1)
Else
nws.Cells(i, j) = txtArray(j - 2)
End If
nws.Cells(i, j).HorizontalAlignment = xlCenter
Next
'2行目以降はデータ行なので、文字列にするセルには表示形式を文字列（@）にする
Else
nws.Cells(i, 1).NumberFormat = "@"
nws.Cells(i, 1) = txtArray(1)
'2列目から5列目まではETCカード.xlsxのカード利用者からカード番号に該当する部門～氏名を代入する
For k = 2 To ws.Cells(2, 1).End(xlDown).Row
If txtArray(1) = ws.Cells(k, 1) Then
For j = 2 To 5
nws.Cells(i, j) = ws.Cells(k, j)
Next
Exit For
End If
Next
'日付のデータは日付のシリアル値に変換して表示形式を日付に設定する
nws.Cells(i, 6) = Format(DateSerial(Left(txtArray(3), 4), _
Mid(txtArray(3), 5, 2), Right(txtArray(3), 2)), _
"yyyy/m/d")
For j = 7 To 12
If j > 10 Then
nws.Cells(i, j) = Format(txtArray(j - 1), "#,##0")
Else
nws.Cells(i, j).NumberFormat = "@"
nws.Cells(i, j) = txtArray(j - 2)
End If
Next
End If
i = i + 1
Loop
'CSVデータが1件以上あった場合は、列幅を自動調整して、格子線を引く
If i > 1 Then
For l = 1 To 12
nws.Columns(l).AutoFit
Next
nws.Range("A1").CurrentRegion.Borders.LineStyle = _
xlContinuous
'システム日付からファイル名に年月日を付加したファイル名を生成して、名前を付けて保存をする
saveName = Year(Date) & Format(Month(Date), "00") & _
Format(Day(Date), "00") & "ETCデータ.xlsx"
nwb.SaveAs Filename:=CurrentPath & "\" & saveName
End If
'CSVファイルとETCxxxxx.xlsxを閉じて、ETCxxxxx.xlsxのオブジェクト変数を開放する
Close #intFree
wb.Close
Set wb = Nothing
Set ws = Nothing
Set nwb = Nothing
Set nws = Nothing
CSVデータを全件読み込むため、変数iはCSVファイルのデータ行と新規ブックの編集シートの行数を示します。CSVデータの項目で必要なものを、配列から取り出します。CSVデータのレイアウトにより、配列からの取り出し場所が変わります。
コメント付きのソースでやや見づらいかもしれませんが、このソースコードが読めるようになると、VBAに関してはある程度のレベルに達して、実務に役立つプログラムが組めるようになります。
アクティブブック以外のブックやアクティブシート以外のシートを操作するときに、オブジェクト変数を使うとコーディング作業も楽になります。
VBA応用編がすべて理解できましたら、このようなプログラムが組めるようになります。CSVデータを取り込んで、既存のExcelデータからデータを付加する業務は実用的で、しかも事務作業の負担になっています。これを手作業で行うと半日近くはかかってしまいます。事務作業は合理化すれば時間短縮出来る作業です。ExcelのVBAを活用して、日々の業務を楽にする努力をしていただけたらと思っております。