CSVファイルの活用
筆者の前職は事業所給食サービスの会社で調理師をしていました。仕事柄献立表やレシピ作成のさい食品栄養成分データを扱うことがありました。
具体的には、会社が提供する献立作成システムから献立データをCSVファイルで受け取り、エクセルで加工して食堂内に掲示する献立表やプライスカードなどに表示する栄養情報を自動的に印刷するなどしていました。もちろん、VBAで自動化することで、作業を効率化していたのは言うまでもありません。
栄養成分を計算するソフトなどは会社で用意するシステムではレシピ作成から食材発注、納品、在庫管理など一連の食堂運営を一元的に管理するシステムになっていましたが、全国に数百ある事業所単位では現場のニーズに合わせた細かいデータ処理は各事業所単位に加工できるようCSVファイルで提供するようになっているようでした。
掲示用週間献立表やプライスカードにはその献立のカロリー表示等、主要栄養成分値の表示などを入れ込む必要がありました。また、各事業所管内の保健所への各種提出書類などにも栄養項目のデータを入れ込む必要もあった為、社内システムから吐き出されるCSVファイルを活用することは必須だったわけです。VBAのスキルを活かして自分の仕事環境をより効率的に構築できるのですからぜひとも皆さん方にも挑戦していただきたいと思います。
練習帳のダウンロード
データベースを作成
テスト用データベースを作成する
最初に、ダウンロードしたファイルのワークシートには何もデータがありませんから、練習用のデータを書き込みします(データベースを作成)。
CSVファイルに書き出す
ファイルを開きます。
ダイアログが開いたらデータベースを発見した旨メッセージを確認できます。
書出しボタンを押すと瞬時に作業が終わります。
書き出しましたのメッセージが出るのでOKボタンを押します。
メッセージにはファイルが書き出されたフォルダー名が書いてあります。
(設定ではデスクトップのtesutfoludrに格納するようになってます)
一応確認してみましょう。

上図の様にtestfoldrを開くとファイル名CSVdata.csvがあるので、それを開くと下図のようになっていました。(書き出す前のシート上のセルのデータがカンマを区切りにして書き出されているのがわかりますね。)

CSVファイルに書き出すメイン処理(入れ子のFor…Next)
フォームの書出しボタン で呼び出されるプロシージャの解説になります。
行番号30行目の For j = 1 To DBcです。そして、31行目 txt = kanmaText(Cells(g + i, r + j)) の
Cells(g + i, r + j)でワークシートのセルのデータを取り出しています。カンマの左側はセルの行位置で右側が列位置ですから、最初のForでiに1が入ってくるのでシートのデータベースの一行目を意味します。
そして、次の入れ子のForで、一行目の列の位置を順次入れ替えてデータを取り出しています。列のすべてのデータを取り終わったら最初のForに戻って次にiに2が入って2行目のデータの取り出しをするという具合です。DBr、DBcはワークシート上のデータベースの大きさで最大行数と最大列数を表しています。更に、ワークシート上のデータベースの始まる位置情報gとrをプロシージャの引数として受け取ってこれをセルの行と列にそれぞれ加算しています。そして、取り出したデータをkanmaText()関数に送って。データ中にカンマが含まれていた時はこれを取り除いています。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
Public Sub kakidasi_DBdata_csv(DBr As Integer, DBc As Integer, g As Integer, r As Integer) 'シートにあるDBをカンマ区切りのCSVファイルに書き出す Dim csvfoldr As String 'フォルダー名用 Dim csvFile As String 'ファイル名用 Dim fnum As Integer 'ファイルナンバー用 Dim i As Long '行の繰り返し用 Dim j As Long '列の繰り返し用 Dim txt As String 'テスト用のフォルダーを作って格納 csvfoldr = ActiveWorkbook.Path & "\testfoldr" 'フォルダーが無ければ作成 If Dir(csvfoldr, vbDirectory) = "" Then MkDir csvfoldr End If '格納するcsvファイルの名前を設定 csvFile = csvfoldr & "\CSVdata.csv" 'ファイルナンバーを取得 fnum = FreeFile 'ファイルを開いてデータを書き込む Open csvFile For Output As fnum For i = 1 To DBr '行の繰り返しよう For j = 1 To DBc '列の繰り返し txt = kanmaText(Cells(g + i, r + j)) '値にカンマが含まれていたら「”」で囲う。 If j <> DBc Then Print #fnum, txt & ","; Else Print #fnum, txt & vbCr; End If Next j Next i Close #fnum MsgBox csvFile & "に書き出しました" End Sub |
保存済みCSVファイルをワークシートに読み込む
前項で書き出したCSVファイルをワークシートに読み込みします。
UserForm1の読込みボタンを押します。

その時点でワークシート上にあるデータベースは削除しますから、OKボタンを押します。
続いて、読込むファイルを選択するダイアログが表示されるので、その中からCSVdata.csvを選択して開きます。(OKボタンを押します)
ほぼ、瞬時にワークシートにCSVファイルの内容がワークシートに張り付きます。
ここからは、フォームの読込みボタンので呼び出されるプロシージャの解説になります。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 |
Public Sub yomikomiKaisi() Dim varFileName As Variant Dim intFree As Integer Dim strRec As String Dim strSplit() As String Dim i As Long Dim j As Long ChDir ActiveWorkbook.Path & "\testfoldr" '開くフォルダーを指定 varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _ Title:="CSVファイルの選択") If varFileName = False Then Exit Sub End If intFree = FreeFile '空番号を取得 Open varFileName For Input As #intFree 'CSVファィルをオープン i = 0 Do Until EOF(intFree) Line Input #intFree, strRec '1行読み込み i = i + 1 strSplit = Split(strRec, ",") 'カンマ区切りで配列へ For j = 0 To UBound(strSplit) '一行分ずつデータをシートに書出し ActiveSheet.Cells(i, j + 1) = strSplit(j) Next Loop Close #intFree End Sub |
読込み処理の要、Do…Loopを使った繰り返し処理
今までは主にFor…Nextの繰り返し処理を使ってきましたが、ここではDo…Loopを使います。For…Nextは繰り返す回数がわかっているときに使いますが、今回のようなCSVファイルは前もって行数を知ることができないので、その場合は
Do Until EOF()を使います。
Until EOF(intFree)の意味は、
行番号19行目のOpen varFileName For Input As #intFreeで開いたintFree番目のファイルを指定してそのファイルの終端(EOF)に達するまで繰り返しを実行するということです。
次に、
行番号24行目でファイルの一行分を取り出して
行番号27行目でその一行分のデータをカンマで区切って配列に格納します。
そして、今度は入れ子のFor…Nextを使って、一行分のデータが入った配列のデータをワークシートのセルに書き出しています。
行番号29行目 For j = 0 To UBound(strSplit) の UBound(strSplit)は引数になっている配列の要素数を返す関数ですから、その要素数だけ繰り返します。
メインのコード
UserFormコード
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 |
Dim frg As Boolean Private Sub btnkakidasi_Click() '書出しボタンの処理 '前提‐‐‐B3から始まるデータベースがある 'データベースの把握 Dim i As Integer Dim r As Integer Dim kaisiG As Integer Dim kaisiR As Integer Dim idxC As Integer Dim str As String If Lsentou.Caption <> "---" Then i = Range(Lsentou).CurrentRegion.Columns.Count r = Range(Lsentou).CurrentRegion.Rows.Count str = Range(Lsentou).Address(, , xlR1C1) idxC = InStr(str, "C") kaisiG = Mid(str, 2, idxC - 2) - 1 kaisiR = Mid(str, idxC + 1) - 1 'MsgBox kaisiG & "=" & kaisiR Call kakidasi_DBdata_csv(r, i, kaisiG, kaisiR) End If End Sub Private Sub btnyomikomi_Click() Call csvYomikomi End Sub Private Sub CommandButton1_Click() Call DBfind End Sub Private Sub UserForm_Activate() If frg = True Then Me.Hide End Sub Private Sub UserForm_Initialize() Call DBfind End Sub 'csvファイルを読込んでワークシート上にデータを展開します。 Private Sub csvYomikomi() Dim str As String Dim sika As String Dim adresu As String str = sentouAddress(TextBox1.Value, TextBox2.Value) If str <> "" Then 'ワークシート上にデータベースがあれば削除しておきます。 If MsgBox("既存のデータベースを、削除してから読込みます。削除してもいいですか?", 17, "削除確認") = vbOK Then sika = InStr(str, "■") adresu = Mid(str, 1, sika - 1) Range(adresu).CurrentRegion.Delete MsgBox "ダイアログから、CSVファイルを指定して下さい" '読込み開始 yomikomiKaisi End If Else yomikomiKaisi End If End Sub 'データベースを探して、あればcsvデータとして書き出します Private Sub DBfind() Dim adresu As String Dim gyou As String Dim retu As String Dim str As String Dim sika As Integer Dim gyo As Integer Dim csvfoldr As String frg = False str = sentouAddress(TextBox1.Value, TextBox2.Value) sika = InStr(str, "■") gyo = InStr(str, "行") csvfoldr = ActiveWorkbook.Path & "\testfoldr" If str = "" And Dir(csvfoldr, vbDirectory) = "" Then MsgBox "まず、データベースを作成してください。" & Chr(13) & Chr(13) _ & "作成後、保存してファイルを閉じて、再度開いて下さい。" frg = True Exit Sub ElseIf str = "" Then MsgBox "データベースは発見できませんでした。" & Chr(13) & Chr(13) _ & "行列を調整して再度探索してください" & Chr(13) & Chr(13) _ & "あるいは、読込みボタンからデータベースを読込んでください" CommandButton1.Enabled = True btnkakidasi.Enabled = False Else adresu = Mid(str, 1, sika - 1) gyou = Mid(str, sika + 1, gyo - sika) retu = Mid(str, gyo + 1) Lsentou.Caption = adresu Label9.Caption = gyou & "、" & retu & "列のデータベースを発見しました" CommandButton1.Enabled = False btnkakidasi.Enabled = True If Dir(csvfoldr, vbDirectory) = "" Then btnyomikomi.Enabled = False End If End If End Sub |
Moduleコード
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 |
Public Sub yomikomiKaisi() Dim varFileName As Variant Dim intFree As Integer Dim strRec As String Dim strSplit() As String Dim i As Long Dim j As Long ChDir ActiveWorkbook.Path & "\testfoldr" '開くフォルダーを指定 varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _ Title:="CSVファイルの選択") If varFileName = False Then Exit Sub End If intFree = FreeFile '空番号を取得 Open varFileName For Input As #intFree 'CSVファィルをオープン i = 0 Do Until EOF(intFree) Line Input #intFree, strRec '1行読み込み i = i + 1 strSplit = Split(strRec, ",") 'カンマ区切りで配列へ For j = 0 To UBound(strSplit) '一行分ずつデータをシートに書出し ActiveSheet.Cells(i, j + 1) = strSplit(j) Next Loop Close #intFree End Sub Public Sub kakidasi_DBdata_csv(DBr As Integer, DBc As Integer, g As Integer, r As Integer) 'シートにあるDBをカンマ区切りのCSVファイルに書き出す Dim csvfoldr As String 'フォルダー名用 Dim csvFile As String 'ファイル名用 Dim fnum As Integer 'ファイルナンバー用 Dim i As Long '行の繰り返し用 Dim j As Long '列の繰り返し用 Dim txt As String 'テスト用のフォルダーを作って格納 csvfoldr = ActiveWorkbook.Path & "\testfoldr" 'フォルダーが無ければ作成 If Dir(csvfoldr, vbDirectory) = "" Then MkDir csvfoldr End If '格納するcsvファイルの名前を設定 csvFile = csvfoldr & "\CSVdata.csv" 'ファイルナンバーを取得 fnum = FreeFile 'ファイルを開いてデータを書き込む Open csvFile For Output As fnum For i = 1 To DBr '行の繰り返しよう For j = 1 To DBc '列の繰り返し txt = kanmaText(Cells(g + i, r + j)) '値にカンマが含まれていたら「”」で囲う。 If j <> DBc Then Print #fnum, txt & ","; Else Print #fnum, txt & vbCr; End If Next j Next i Close #fnum MsgBox csvFile & "に書き出しました" End Sub '書き込む値にカンマが含まれているときは、カンマを取り除く '(例えば25,000の様な金額表示などの3桁区切り記号が付いているとき) '(カンマの左右が別データと扱われてしまうためこれを防ぎます) Private Function kanmaText(txt As String) As String If InStr(txt, ",") > 0 Then kanmaText = Replace(txt, ",", "") Else kanmaText = txt End If End Function '一列ずつ縦の下方向に調べてデータが発見されたセル範囲の行数と列数を返す Public Function sentouAddress(gyou As Integer, retu As Integer) As String Dim r As Integer Dim i As Integer Dim adores As String Dim rowCount As Integer Dim colCount As Integer For i = 1 To retu For r = 1 To gyou If Cells(r, i) <> "" Then adores = Cells(r, i).Address Range(adores).Select rowCount = Range(adores).CurrentRegion.Rows.Count colCount = Range(adores).CurrentRegion.Columns.Count '最初に見つけたデータが一行だけならそれは表題とみなして無視する If rowCount > 1 And colCount > 1 Then sentouAddress = adores & "■" & rowCount & "行" & colCount Exit Function End If sentouAddress = "" End If Next r Next i End Function |
コメント