その③でExcelファイル（ブック形式）の操作について書きました。
今回はCSVファイルを疑似データベースとして扱うコードサンプルを使って、CSVファイルの操作方法を説明していきます。
前回は、ただやり方をダラダラ書いてしまったので、今回は少し書き方を変えて、みなさんのPC上に動くサンプルを説明前に準備していただき、実際に動かしながら、説明を読んでいただくようにします。その方が理解しやすいのかな？と思いますし、そのままコードサンプルをベースに改造して使えるかな？！と思いました。もし、そのように使っていただければ嬉しく思います！
また全部いっぺんに書くととんでもなく長くなるので、前編、後編にわけて書きます。前編でサンプルを動かす準備と使い方、後編でコードの説明をしていきます。
さて、いつも前置きが長くなるので、先に準備から始めようと思いますが、この記事を読み進めて「なんだCSV使えないじゃないか！」となってしまっては、記事を読んだ時間が無駄になってしまうので、一つだけ先に書いておきます。
MicrosoftのOneDriveでファイル共有便利ですよね。Officeがサブスクになって、導入する会社も多くなったのではないでしょうか？でも、残念ながらOneDrive上ではCSVファイル操作ができません。Windowsもデータベースの仕組み持っていますから、そっち使えってことでしょうか（笑）フリーソフトかませると使えるみたいですが、私やったことないので紹介できません。。。申し訳ない。。。CSVファイルを疑似データベースのように使えるなら、OneDrive上でファイルを共有すれば、簡易社内システムが作れるかも？！と考えちゃいますよね。実は、私、このことを知らずに、一度作成に取り組んでしまい、結局、使えずに途方にくれた経験があります。費やした時間は戻らないので、トライする前に事前調査。。。大切ですね。気をつけてください。
それではみなさんのPCでこのサンプルコードを使う準備です。
1.フォルダとファイルの準備
次の画層のようにご準備ください。
- PCの任意の場所に任意の名前でフォルダを作成
- フォルダ内にマクロ有効ブック形式で画像のようなシートを作成
ブック名、シート名は任意で構いません。始めはシートを１枚にしておいてください。 - フォルダ内に「DataBase」という名前のフォルダを作成
できましたでしょうか？
もし、シートにボタンの配置方法がわからない方は過去の記事にあります。先にそちらを見て、戻ってきてください。
「サンプルファイルをダウンロードさせてよ！！」と聞こえてきそうです（笑）
でも、自分で言うのもなんですが、わけのわからない人(私^^;）が作ったものをダウンロードして使うって怖くないですか？
まあ、VBAの扱いになれる為だと思ってお付き合いください。案外このやり方のほうがいいかもですよ！
2.VBAコードの配置
次にコードです。先に作成してもらったマクロ有効ブックに入れます。
入れる場所は下の３つになります。
- Workbookに配置するもの
- Worksheetに配置するもの
- Moduleに配置するもの
それではそれぞれ配置していきます。
1.Workbookに配置するもの
コピペは下のコードです。
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ThisWorkbook.Worksheets(1).Range("B2").Validation.Delete
End Sub説明は後編で詳しく。
2.Worksheetに配置するもの
コピペは下のコードです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim f_name As String, buf() As Variant, cnt As Long, d_up As Long, i As Long
Dim ck As Variant
With Target
If .Address = "$B$2" Or .Address = "$B$2:$D$2" Then
ck = ActiveSheet.Range("B2")
If .Validation.Value = False Or ck = "" Then
Application.EnableEvents = False
Call sheet_clear(2)
Application.EnableEvents = True
Else
f_name = Dir(ThisWorkbook.Path & "¥DataBase¥*.csv")
cnt = 0
Do While f_name <> ""
ReDim Preserve buf(cnt)
buf(cnt) = f_name
f_name = Dir()
cnt = cnt + 1
Loop
If cnt > 0 Then
d_up = UBound(buf)
For i = 0 To d_up
If buf(i) = ck Then
Application.EnableEvents = False
Call staff_Search
Call sheet_clear(1)
Application.EnableEvents = True
Exit For
End If
Next i
End If
End If
End If
End With
End Sub上の画像で、Sheet1に続くカッコ内が(Staff_REG)となってますが、これは私がつけたシート名になっているだけです。任意のシート名をつけている場合はその名前が出てくると思います。何もつけてない方は（Sheet1）です。
ここも説明は後編で詳しく書きます。
3.Moduleに配置するもの
コピペは下のコードです。ちょっと長いですが、そのまま貼り付けてください。
上の図でも書いてますが、コードの境目ラインはコピペすると勝手に引かれます。
Option Explicit
Dim staff_data() As Variant
Dim s_sheet As Worksheet
Sub sheet_setting()
Set s_sheet = ThisWorkbook.Worksheets(1)
End Sub
Function file_check() As Variant()
Dim result_arr(3) As Variant
Call sheet_setting
result_arr(0) = False 'ファイルの有無
result_arr(3) = False 'ファイルが開かれているか
If Dir(ThisWorkbook.Path & "¥DataBase¥" & s_sheet.Range("B2")) = s_sheet.Range("B2") Then
result_arr(0) = True
On Error Resume Next
Open ThisWorkbook.Path & "¥DataBase¥" & s_sheet.Range("B2") For Append As #1
Close #1
If Err.Number > 0 Then result_arr(3) = True
On Error GoTo 0
result_arr(2) = ThisWorkbook.Path & "¥DataBase¥" & s_sheet.Range("B2")
End If
result_arr(1) = FreeFile
file_check = result_arr
End Function
Function data_input(f_name As Variant, n As Integer)
Dim buf As Variant, buf_s As Variant, d_up As Integer, cnt As Long, i As Long
cnt = 0
Open f_name For Input As n
Do Until EOF(n)
Line Input #n, buf
buf_s = Split(buf, ",")
d_up = UBound(buf_s)
If cnt = 0 Then
ReDim staff_data(d_up, cnt)
Else
ReDim Preserve staff_data(d_up, cnt)
End If
For i = 0 To d_up
staff_data(i, cnt) = buf_s(i)
Next i
cnt = cnt + 1
Loop
Close n
End Function
Function data_output(f_name As Variant, n As Integer)
Dim buf() As Variant, r_up As Integer, c_up As Long
Dim i As Long, j As Long
r_up = UBound(staff_data, 2)
c_up = UBound(staff_data, 1)
ReDim buf(c_up)
Open f_name For Output As n
For i = 0 To r_up
For j = 0 To c_up
buf(j) = staff_data(j, i)
Next j
Print #n, Join(buf, ",")
Next i
Close n
End Function
Function data_add(f_name As Variant, n As Integer, add_data As String)
Dim buf() As Variant, r_up As Integer, c_up As Long
Dim i As Long, j As Long
r_up = UBound(staff_data, 2)
c_up = UBound(staff_data, 1)
ReDim buf(c_up)
Open f_name For Append As n
Print #n, add_data
Close n
End Function
Function data_sort()
Dim r_up As Integer, c_up As Long
Dim i As Long, j As Long
r_up = UBound(staff_data, 2)
c_up = UBound(staff_data, 1)
Dim no_min As Long, no_max As Long, cnt As Long, staff_data2() As Variant
Dim d_result As Long
staff_data2 = staff_data 'コピーを作る
no_min = 9999999
no_max = 0
cnt = 1
d_result = 0
'番号が小さい順位に並び替え
Do While r_up + 1 <> cnt
For i = 1 To r_up
If Val(staff_data2(0, i)) < no_min And Val(staff_data2(0, i)) > no_max Then
no_min = Val(staff_data2(0, i))
d_result = i
End If
Next i
For j = 0 To c_up
staff_data(j, cnt) = staff_data2(j, d_result)
Next j
no_max = no_min
no_min = 99999999
cnt = cnt + 1
Loop
End Function
Function not_file()
MsgBox "データファイルが見当たりません" & vbCrLf & "DataBaseフォルダを確認してください", vbOKOnly + vbExclamation, "ファイルの確認"
End Function
Function open_file()
MsgBox "データファイルが開かれているようです" & vbCrLf & "データファイルを閉じるか、少し時間をあけて再度操作してください", vbOKOnly + vbExclamation, "ファイルの確認"
End Function
Function sheet_clear(n As Integer)
Dim r As Integer
Call sheet_setting
With s_sheet
If n = 1 Then
r = 4
Else
r = 3
End If
If n = 0 Then
With .Range("B2")
.Validation.Delete
.Value = ""
End With
End If
Dim r_max As Long, c_max As Long
r_max = Rows.Count
c_max = Columns.Count
r_max = .Cells(r_max, 1).End(xlUp).Row
c_max = .Cells(3, c_max).End(xlToLeft).Column
If r_max >= r Then
.Range(.Cells(r, 1), .Cells(r_max, c_max)) = ""
End If
End With
End Function
Sub file_list()
Call sheet_clear(0)
Dim f_name As String, buf() As Variant, cnt As Long
f_name = Dir(ThisWorkbook.Path & "¥DataBase¥*.csv")
cnt = 0
Do While f_name <> ""
ReDim Preserve buf(cnt)
buf(cnt) = f_name
f_name = Dir()
cnt = cnt + 1
Loop
If cnt > 0 Then
With s_sheet.Range("B2").Validation
.Delete
.add Type:=xlValidateList, Formula1:=Join(buf, ",")
.ShowError = False
End With
Else
Call not_file
End If
End Sub
Sub staff_Register()
Dim re_arr As Variant
Dim r_up As Long, c_up As Long
Dim r As Long, c As Long, i As Long, j As Long
Dim add_data As String, cnt As Long
Dim result As String, err_msg As String
re_arr = file_check()
If re_arr(0) = True And re_arr(3) = False Then
Call data_input(re_arr(2), Val(re_arr(1)))
r_up = UBound(staff_data, 2)
c_up = UBound(staff_data, 1)
r = 4
err_msg = ""
Do While s_sheet.Cells(r, 1) <> ""
If IsNumeric(s_sheet.Cells(r, 1)) = False Then
err_msg = err_msg & "・ " & s_sheet.Cells(r, 1) & "は数字ではありません。" & vbCr
End If
For i = 0 To r_up
If s_sheet.Cells(r, 1) = Val(staff_data(0, i)) Then
err_msg = err_msg & "・ " & s_sheet.Cells(r, 1) & "番はすでに使われています。" & vbCr
End If
Next i
r = r + 1
Loop
If err_msg <> "" Then
MsgBox err_msg & vbCr & "データの登録をすべて中止しました。" & vbCr & "上記を修正して再度登録してください。" & _
vbCr & "現在使われている末尾の番号は" & staff_data(0, r_up) & "番です", vbOKOnly + vbExclamation, "番号エラー"
Exit Sub
End If
result = ""
r = 4
Do While s_sheet.Cells(r, 1) <> ""
add_data = ""
For j = 0 To c_up
If j = c_up Then
add_data = add_data & s_sheet.Cells(r, j + 1)
Else
add_data = add_data & s_sheet.Cells(r, j + 1) & ","
End If
Next j
result = result & s_sheet.Cells(r, 1) & vbCr
Call data_add(re_arr(2), Val(re_arr(1)), add_data)
ReDim staff_data(c_up, 0) '一度配列を空っぽにする
Call data_input(re_arr(2), Val(re_arr(1)))
Call data_sort
Call data_output(re_arr(2), Val(re_arr(1)))
r = r + 1
Loop
If result <> "" Then
MsgBox result & "のデータを追加登録しました。", vbOKOnly + vbInformation, "追加登録結果"
Call sheet_clear(1)
End If
Else
If re_arr(3) = True Then
Call open_file
Else
If s_sheet.Range("B2") Like "*.csv" Then
If s_sheet.Range("A3") <> "" Then
r = 3
c = s_sheet.Range("A3").End(xlToRight).Column
cnt = 0
ReDim staff_data(c - 1, cnt)
Do While s_sheet.Cells(r, 1) <> ""
ReDim Preserve staff_data(c - 1, cnt)
For i = 0 To c - 1
staff_data(i, cnt) = s_sheet.Cells(r, i + 1)
Next i
r = r + 1
cnt = cnt + 1
Loop
Call data_output(ThisWorkbook.Path & "¥DataBase¥" & s_sheet.Range("B2"), Val(re_arr(1)))
MsgBox "新規データの登録ができました", vbOKOnly + vbInformation, "ファイル確認"
result = s_sheet.Range("B2")
Call file_list
s_sheet.Range("B2") = result
Else
MsgBox "登録データがありません", vbOKOnly + vbExclamation, "データの確認"
End If
Else
MsgBox "ファイル名に.csvがついていません。", vbOKOnly + vbExclamation, "ファイル確認"
End If
End If
End If
End Sub
Sub staff_Search()
Dim re_arr As Variant
Dim r_up As Long, c_up As Long
Dim r As Long, c As Long, i As Long, j As Long
re_arr = file_check()
If re_arr(0) = True Then
Call data_input(re_arr(2), Val(re_arr(1)))
r = 4
r_up = UBound(staff_data, 2)
c_up = UBound(staff_data, 1)
For i = 1 To c_up + 1
s_sheet.Cells(3, i) = staff_data(i - 1, 0)
Next i
Do While s_sheet.Cells(r, 1) <> ""
For i = 0 To r_up
If s_sheet.Cells(r, 1) = Val(staff_data(0, i)) Then
For j = 1 To c_up
s_sheet.Cells(r, j + 1) = staff_data(j, i)
Next j
Exit For
End If
Next i
r = r + 1
Loop
Else
Call not_file
End If
End Sub
Sub staff_Delete()
Dim re_arr As Variant
Dim r_up As Long, c_up As Long
Dim r As Long, c As Long, i As Long, j As Long, k As Long
Dim r_max As Long, result As String
re_arr = file_check()
result = ""
If re_arr(0) = True And re_arr(3) = False Then
Call data_input(re_arr(2), Val(re_arr(1)))
r = 4
Do While s_sheet.Cells(r, 1) <> ""
r_up = UBound(staff_data, 2)
c_up = UBound(staff_data, 1)
For i = 0 To r_up
If s_sheet.Cells(r, 1) = Val(staff_data(0, i)) Then
result = result & s_sheet.Cells(r, 1) & vbCr
For j = i + 1 To r_up
For k = 0 To c_up
staff_data(k, j - 1) = staff_data(k, j)
Next k
Next j
ReDim Preserve staff_data(c_up, r_up - 1)
Call data_sort
Call data_output(re_arr(2), Val(re_arr(1)))
Exit For
End If
Next i
r = r + 1
Loop
If result <> "" Then
MsgBox result & "のデータを削除しました。", vbOKOnly + vbInformation, "削除結果"
Call sheet_clear(1)
End If
Else
If re_arr(0) = False Then Call not_file
If re_arr(3) = True Then Call open_file
End If
End Sub
Sub clear_button()
Call sheet_clear(1)
End Sub
長いですね。あと少しで完成です。
コードの説明は後編でします。
3.ボタンにマクロを登録する
次にシートに配置した５つのボタンにマクロを登録して、コピペしたコードを動かせるようにします。
上のコードをそのまま添付すると、ウインドウに表示されるマクロ名は下の表と一緒のものが表示されるはずなので、それぞれのボタンに登録してください。一気に登録できませんので、ボタン１つ１つ操作して登録します。
| ボタン名 | マクロ名 |
|---|---|
| ファイル一覧 | file_list |
| 登録 | staff_Register |
| 検索 | staff_Search |
| 削除 | staff_Delete |
| クリア | clear_button |
これで準備完了です。できましたでしょうか？
それではコードの説明前に実際に動かしてみます。
現状確認ですが、作成したフォルダの中には、サンプルのExcelファイルとDataBaseフォルダだけあって、データが全くない状態でしょうか？もし、DataBaseフォルダに他のCSVファイルが入っている状態でしたら最初は移動させておいてください。後で戻してもらって結構です。
まず、ファイル一覧ボタンを押してみてください。
CSVファイルはDataBaseフォルダに無い状態ですので、下のような表示が出ると思います。
次にデータファイルを作ってみます。
B2セルに「staff.csv」と入力し、画像のように項目と一緒にデータを入れてみてください。
そして登録ボタンを押します。
このような画面になったかと思います。
OKボタンを押すと、入力したデータ部分だけ消えると思います。
さて、本当にファイルが作成されいるのでしょうか？確認してみましょう。エクスプローラーやFinderからDataBaseフォルダを開いてみてください。
しっかりファイルが作成されていると思います。
次に最初に押したファイル一覧ボタンを押します。
ファイル名も項目も消えてしまいました。そのまま、セルB2にカーソルを合わせてみてください。ドロップダウンリストが設定されていると思います。
先程作成したファイル名がリストに出てきました。
ファイル名を選択してみてください。
先程登録した項目だけが表示されました。
そのまま画像のように別のデータを１行入力します。
登録ボタンを押してください。
idの番号とともに追加登録されたメッセージが出ました。OKボタンを押すと、先程と一緒の動きでデータ部分だけ消えました。
それでは、登録されたかデータを確認します。
idのところに160と入力してください。
それでは、検索ボタンを押してください。
先程のデータが表示されました。
そのまま登録ボタンを押してみてください。
同じ番号では登録できないとガードが入ります。
それでは削除ボタンを押してみてください。
削除しましたたとメッセージが出ました。
試しにもう一度160と入れて検索すると何も動かないと思います。
それでは、一番最初に入力したデータから３つを検索してみます。
100、130、150と入れて検索しましょう。
でました。
ではそのまま削除してみてください。
一気に３行消せました。
次にidをデータの間に入る番号で入れてみます。
125を使ってデータを入れ、登録してみます。
入りました。データの位置はどうなっているのでしょうか？追加なら最後でしょうか？
CSVファイルを直接開いて確認してみてください。
データが並び替えられ入ってます。これは並び替えのコードが働いているからです。
CSVファイルを閉じてください。
それではidが文字列だったらどうでしょうか？
文字で入力して登録ボタンを押してみてください。
このように数字以外は受け付けない仕様にしてますので、文字を発見したら処理を止める命令が入ってます。
次は、操作によって変わるシートの動きをみます。
ファイル一覧ボタンをおしてください。すべてが消えると思います。
その状態でファイル名にoffice.csvといれてみてください。
Excelの入力規制でプルダウンリストを設定してますが、リストを保持したままリスト以外の値も入力できる設定になってます。入力によりデータを消したり、表示したりするのはworksheetに入れたコードのおかげです。
では、このまま別ファイルを作成してみます。
入力したファイル名のまま、次のようなデータを入れてください。項目もしっかり入れてください。
登録ボタンを押すと
新規扱いで登録されました。
ファイル名のリストを見てみます。
ちゃんとファイルが２つになっています。
しっかりCSVファイルになっているかエクスプローラー（もしくはFinder) から直接開いてみてください。
できていましたでしょうか？
それでは、CSVファイルを開いたまま操作してみます。
ファイル一覧を押して、office.csvをリストから選んでください。
そのままidに10を入力して検索してみてください。
ファイルが開いたままでもファイル一覧の取得と検索は可能でした。
では、そのまま削除ボタンを押してみてください。
ファイルが開いていると書き込みができないのでエラーになります。エラーにならないように先に開いているかチェックする機能を入れてます。登録も書き込みになるので同様の表示が出ます。
このサンプルは、データの項目をCSVのレコードの先頭に入れて、それを表示するようにしています。そうすることでデータごとに項目が設定できるようにしているわけです。
この仕組みにしておけば、あと少し手を加えることで、CSVファイルをテーブルと見立てて、それぞれのカラム名で検索したりできます。実際のデータベースと似た動きができるというわけです。
また、最初に私がサンプルで提示したシートの表が、４列10行なのでデータに制限があるように見えますが、、、実はデータ数は制限つけてません。試しに別のデータファイルで列、行を多くして作成してみてください。動くはずです 。
さらに、他にCSVファイルが有る方はDataBaseフォルダに入れてみてください。ファイル一覧でヒットして表示もできると思います。ただ、最初のレコードは項目、idをレコードの最初（一番左端）に固定していますので、形が違うデータはうまく動かないと思います。また、一度作成したデータファイルの項目数を増やすことはできないようになってます。増やすとエラーが出てプログラムが止まるでしょう。
このように、フォーマットやフォームの形というのは、実はとても大切です。表を作って色をつけただけなのに、入力できない錯覚に陥るわけです。プログラミングのガード無しでも、フォームである程度は行動制限できてしまうんですね。
また、実際に運用することを考えてみると、このサンプルで未対応になっていることは、入力するデータの間に空白があるとデータがそこで終わりと判断してしまうことと、idと項目でデータ数を判断していますので、id無しではうまく動きません。
このサンプルはCSVファイルの操作方法を説明する目的なので、データベースと同じように扱うには、少し足りません。idのオートインクリメント機能やデータの上書き、列の挿入、、、などなど運用を考えるとまだまだ足りませんね。そのあたりは前編後編とは別に付録として追加コードを書こうと思います。しばしお待ち下さい。
さて、、、、現在、後編を作成中です。
後編を作成しながら、無駄なコードを発見して修正したり、機能追加したくなったりと、この記事自体を変更しちゃっています。
もし、最初に見たコードと変わっていたら、「なんか間違ってたんだな・・・」と思ってください。
最初にアップしてから、今回で別コードになるぐらい変わってます。【21年10月8日】
（このあとから追記、変更履歴は記事の最後にいれることにします。）
