VBAを使って表のデータを検索するシステムを作ってました。検索システム自体は(当初の必要機能は)完成したので、今後万が一VBAを書くことになったときのためにメモを残しておきます。
VBAは初めて触ったので、変な実装になっている可能性があります。
目次
1.やりたいこと
同じブック内の表から学年と科目を入れると教えられる講師の講師番号、名前、電話番号を表示したい。
検索フォームは次の画像のようになった。
2.成果物
3.システムの大枠の参考にしたサイト
4.VBAをVSCodeで編集したい
VBE(Visual Basic Editor)は使いにくいです。VSCodeに慣れてしまった体からしたら耐えられないです。ということで、VBAをVSCodeで編集します。
4-1.参考サイト
4-2.準備するもの
- vbac.wsf
- Excel(予めモジュールなどを挿入しておく)
- VSCode
4-3.vbac.wsfをダウンロード
下記のレポジトリからダウンロードします。
vbac.wsf以外は使わないので消しても大丈夫です。
4-4.指定の階層構造を作る
4-3でダウンロードしたvbac.wsfとExcelファイルを次のような階層構造にします。
Folder
├ bin
│ └ Excel file
└ vbac.wsf
4-5.Excelのセキュリティ設定の変更
Excelのオプションからトラストセンター→トラストセンターの設定→マクロの設定→VBAプロジェククオブジェクトモデルへのアクセスを信頼するにチェックを入れる。
4-6.オブジェクトを書き出す
PowerShellやコマンドプロンプトで、4-4で作ったvbac.wsfがあるディレクトリに移動します。
そのディレクトリ内で次のコマンドを実行します。
cscript vbac.wsf decombine
コマンドの実行後、4-4で作った階層構造が次のように変化します。
Folder
├ bin
│ └ Excel file
├ src
│ └ Folder2
│ ├ Module1.bas
│ ├ Sheet1.dcm
│ ├ UserForm1.frm
│ └ UserForm1.frx
└ vbac.wsf
書き出されるファイルは一例であり、VBEで予め作成していたモジュールやユーザフォーム、クラスによって変わります。
注意ですが、必ず予めモジュールなどをVBE上で作成してください。そうでない場合何も書き出されません。
4-7.VSCodeにVBAを書くための拡張機能をインストール
VSCode拡張機能からVBAと検索して出てきたものから選べばいいです。
VSCode VBA
シンタックスハイライトとかをしてくれます。
vba-snippets
スニペットをいくつか追加してくれます。
vscode-vba-icons
vba関連のアイコンを追加してくれます。
4-8. ファイルをVBEに取り込む
4-6と同じディレクトリで次のコマンドを実行します。
cscript vbac.wsf combine
4-9.デバッグはVBEで行う
VBEでデバッグを行います。
結局VBE上で書き直してデバッグしてを繰り返すので、だんだんオブジェクトを書き出すのがめんどくさくなります。
意外とVBEはデバッグ機能に関しては優秀。
5.ユーザフォームの作成
VBEから作れます。GUIで作れるので簡単。変なところをダブルクリックすると、そのオブジェクトに対するソースコードを記述するウィンドウが開くのが厄介。ダブルクリックに自信がない場合はオブジェクトのプロパティからラベルなども編集できるので、そっちのほうがいいかもしれない。
また、オブジェクトをコピペできるが、それぞれに勝手に番号が振られる(ComboBox1のように)ので、バグを防ぐために上から番号順に同じオブジェクトは並べたほうがいい。
6.コード全体
6-1. UserForm1.frm
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| VERSION 5.00 | |
| Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UserForm1 | |
| Caption = "講師検索システム" | |
| ClientHeight = 10215 | |
| ClientLeft = 120 | |
| ClientTop = 465 | |
| ClientWidth = 10980 | |
| OleObjectBlob = "UserForm1.frx":0000 | |
| StartUpPosition = 1 'オーナー フォームの中央 | |
| End | |
| Attribute VB_Name = "UserForm1" | |
| Attribute VB_GlobalNameSpace = False | |
| Attribute VB_Creatable = False | |
| Attribute VB_PredeclaredId = True | |
| Attribute VB_Exposed = False | |
| Private Sub ComboBox1_Change() | |
| Call Sheet1.makeCombobox2 | |
| End Sub | |
| Private Sub ComboBox2_Change() | |
| Call Sheet1.makeCombobox3 | |
| End Sub | |
| '検索を実行する' | |
| Private Sub CommandButton1_Click() | |
| Dim lastRow As Long, lastColumn As Long '最終行、最終列の位置' | |
| Dim allData, resultData() '全てのデータを格納する、結果のデータを格納する' | |
| Dim i As Long, j As Long, cnt As Long 'for文とかで使ういつもの変数' | |
| Dim sex As String 'オプションボタンの値を格納する変数' | |
| Dim subjectNum As Long '科目番号を格納する変数' | |
| '検索するデータの全体をallDataに格納する' | |
| With Worksheets("sarchable") 'sarchableシートを参照する' | |
| lastRow = .Cells(Rows.Count, 1).End(xlUp).Row '最終行の取得' | |
| lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column '最終列の取得' | |
| allData = .Range(.Cells(1, 1), .Cells(lastRow, lastColumn)).Value '最終行までデータを取得する' | |
| End With | |
| '科目番号を取得' | |
| subjectNum = Sheet1.subjectNum(ComboBox1.Value, ComboBox2.Value, ComboBox3.Value) | |
| '氏名のみ検索,科目のみ検索、氏名&科目検索のいずれかに分岐する' | |
| If TextBox1.Value = "" And Not subjectNum = -1 Then | |
| '科目の検索' | |
| Call sarchSubjectOnly(lastRow, subjectNum, allData) | |
| ElseIf Not TextBox1.Value = "" And subjectNum = -1 Then | |
| '氏名のみ検索' | |
| Call sarchTutorOnly(lastColumn, allData) | |
| ElseIf Not TextBox1 = "" And Not subjectNum = -1 Then | |
| '氏名&科目検索' | |
| Call sarchOnly(subjectNum, allData) | |
| End If | |
| End Sub | |
| '科目のみの検索' | |
| Sub sarchSubjectOnly(lastRow As Long, subjectNum As Long, allData As Variant) | |
| 'オプションボタンの状態を取得(性別を取得)' | |
| If OptionButton1 = True Then '指定なし' | |
| sex = OptionButton1.Caption | |
| ElseIf OptionButton2 = True Then '男性' | |
| sex = OptionButton2.Caption | |
| ElseIf OptionButton3 = True Then '女性' | |
| sex = OptionButton3.Caption | |
| End If | |
| '検索結果を格納するために動的確保する' | |
| ReDim resultData(1 To lastRow, 1 To 3) | |
| '検索で一致したデータをresultDataに格納する' | |
| 'コンボボックスをすべて埋めてない時の動作(異常終了)' | |
| If subjectNum = -1 Then | |
| MsgBox "学年、科目、詳細な科目はすべて選択してください" | |
| Else | |
| '性別:指定なしの時' | |
| If sex = "指定なし" Then | |
| For i = LBound(allData) To UBound(allData) | |
| If i = 1 Or allData(i, subjectNum) = "はい" Then | |
| cnt = cnt + 1 | |
| resultData(cnt, 1) = allData(i, 1) '講師番号' | |
| resultData(cnt, 2) = allData(i, 2) '講師名' | |
| resultData(cnt, 3) = allData(i, 3) '電話番号' | |
| End If | |
| Next i | |
| Else | |
| '性別指定ありのとき' | |
| For i = LBound(allData) To UBound(allData) | |
| If i = 1 Or (allData(i, 4) Like sex And allData(i, subjectNum) = "はい") Then | |
| cnt = cnt + 1 | |
| resultData(cnt, 1) = allData(i, 1) '講師番号' | |
| resultData(cnt, 2) = allData(i, 2) '講師名' | |
| resultData(cnt, 3) = allData(i, 3) '電話番号' | |
| End If | |
| Next i | |
| End If | |
| End If | |
| 'リストボックに表示' | |
| With ListBox1 | |
| .ColumnCount = 3 | |
| .ColumnWidths = "50;70;50" | |
| .List = resultData | |
| End With | |
| End Sub | |
| '氏名のみ検索' | |
| Private Sub sarchTutorOnly(lastColumn As Long, allData As Variant) | |
| Dim tutorName As String | |
| Dim i As Long, j As Long, k As Long | |
| Dim flag As Boolean | |
| ReDim resultData(1 To lastColumn) | |
| tutorName = TextBox1.Value | |
| 'フラグ初期化' | |
| flag = False | |
| '講師名検索' | |
| For i = LBound(allData) To UBound(allData) | |
| If InStr(allData(i, 2), tutorName) Then | |
| '該当講師に関する情報だけ一次元配列に格納' | |
| For j = 5 To lastColumn | |
| resultData(j - 4) = allData(i, j) | |
| Next j | |
| '講師が見つかったらフラグを立ててループを抜ける' | |
| flag = True | |
| Exit For | |
| End If | |
| Next i | |
| 'フラグで分岐させる' | |
| If flag = True Then | |
| '幾何と代数の情報をを配列内から削除する' | |
| For k = 18 To UBound(resultData) | |
| resultData(k - 2) = resultData(k) | |
| Next k | |
| '結果を表示させる' | |
| Call showResult(resultData) | |
| Else | |
| MsgBox "講師が見つかりませんでした", vbOKOnly, "講師が見つからない" | |
| End If | |
| End Sub | |
| '氏名のみ検索の結果作成' | |
| Private Sub showResult(resultData As Variant) | |
| Dim lastRow As Long | |
| Dim subjectCnt As Long, resultCnt As Long, i As Long, j As Long | |
| Dim subjectsList | |
| ReDim showList(1 To 22, 1 To 6) | |
| 'カウントの初期化' | |
| subjectCnt = 18 | |
| resultCnt = 1 | |
| '科目データの取得(仕様で二次元配列で取得する)' | |
| With Worksheets("subjects") | |
| lastRow = .Cells(Rows.Count, 1).End(xlUp).Row '最終行の取得' | |
| subjectsList = .Range(.Cells(1, 3), .Cells(lastRow, 3)).Value '最終行までデータを取得する' | |
| End With | |
| 'あらかじめshowListに入れておくデータ' | |
| showList(1, 1) = "小学生" | |
| showList(3, 1) = "中学受験" | |
| showList(5, 1) = "中学生" | |
| showList(7, 1) = "高校生" | |
| showList(19, 1) = "英語検定" | |
| '科目リストと表示形式の順番が異なるので手動で入れておくデータ' | |
| showList(1, 2) = subjectsList(2, 1) '英語' | |
| showList(1, 3) = subjectsList(3, 1) '数学' | |
| showList(1, 4) = subjectsList(5, 1) '国語' | |
| showList(1, 5) = subjectsList(7, 1) '理科' | |
| showList(1, 6) = subjectsList(9, 1) '社会' | |
| showList(3, 2) = "" '受験英語の欄は空欄' | |
| showList(3, 3) = subjectsList(4, 1) '受験数学' | |
| showList(3, 4) = subjectsList(6, 1) '受験国語' | |
| showList(3, 5) = subjectsList(8, 1) '受験理科' | |
| showList(3, 6) = subjectsList(10, 1) '受験社会' | |
| showList(5, 2) = subjectsList(11, 1) '英語' | |
| showList(5, 3) = subjectsList(12, 1) '数学' | |
| showList(5, 4) = subjectsList(15, 1) '英語' | |
| showList(5, 5) = subjectsList(16, 1) '数学' | |
| showList(5, 6) = subjectsList(17, 1) '英語' | |
| 'showListに科目データを入れていく' | |
| For i = 1 To 22 | |
| If i = 1 Or i = 3 Or i = 5 Then | |
| GoTo Continue | |
| End If | |
| For j = 2 To 6 | |
| '倫理政治経済のあとは改行したい' | |
| If i = 17 And j = 3 Then | |
| GoTo Continue | |
| End If | |
| '配列の奇数行目は科目を入力' | |
| If i Mod 2 = 1 Then | |
| showList(i, j) = subjectsList(subjectCnt, 1) | |
| subjectCnt = subjectCnt + 1 | |
| Else | |
| '配列の偶数行目はデータを入力' | |
| '倫理政治経済のあとは改行したい' | |
| If i = 18 And j = 3 Then | |
| GoTo Continue | |
| End If | |
| If i = 4 And j = 2 Then | |
| GoTo jContinue | |
| End If | |
| showList(i, j) = resultData(resultCnt) | |
| resultCnt = resultCnt + 1 | |
| End If | |
| jContinue: | |
| Next j | |
| Continue: | |
| Next i | |
| With ListBox1 | |
| .ColumnCount = 6 | |
| .ColumnWidths = "50;60;60;60;60;60" | |
| .List = showList | |
| End With | |
| End Sub | |
| '氏名&科目検索' | |
| Private Sub sarchOnly(subjectNum As Long, allData As Variant) | |
| Dim tutorName As String | |
| Dim i As Long | |
| Dim flag As Boolean | |
| 'フラグの初期化' | |
| flag = False | |
| '講師名取得' | |
| tutorName = TextBox1.Value | |
| '氏名と科目で検索' | |
| For i = LBound(allData) To UBound(allData) | |
| If InStr(allData(i, 2), tutorName) And allData(i, subjectNum) = "はい" Then | |
| '可能ならフラグを立ててFor文を抜ける' | |
| tutorName = allData(i, 2) | |
| flag = True | |
| Exit For | |
| End If | |
| Next i | |
| 'フラグによってメッセージボックスを出す' | |
| If flag = True Then | |
| MsgBox tutorName & "は" & ComboBox3.Value & "を教務可能です。", vbOKOnly, "教えられる？" | |
| Else | |
| MsgBox tutorName & "は" & ComboBox3.Value & "を教務できません。", vbOKOnly, "教えられる？" | |
| End If | |
| End Sub | |
| '検索結果を初期化' | |
| Private Sub CommandButton2_Click() | |
| Call UserForm_Initialize | |
| End Sub | |
| 'ユーザフォームの初期化' | |
| Private Sub UserForm_Initialize() | |
| 'オプションボタンの状態を初期化' | |
| OptionButton1 = True | |
| 'コンボボックスを初期化' | |
| Call Sheet1.box_Initalize | |
| 'テキストボックスの初期化' | |
| TextBox1.Text = "" | |
| 'リストボックスの初期化' | |
| ListBox1.Clear | |
| End Sub |
by 6-2. Sheet1.dcm
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| VERSION 1.0 CLASS | |
| BEGIN | |
| MultiUse = -1 'True | |
| END | |
| Attribute VB_Name = "Sheet1" | |
| Attribute VB_GlobalNameSpace = False | |
| Attribute VB_Creatable = False | |
| Attribute VB_PredeclaredId = True | |
| Attribute VB_Exposed = True | |
| 'コンボボックス1,2,3を初期化する' | |
| Sub box_Initalize() | |
| Dim checkDic As Object 'ディクショナリ' | |
| Dim lastRow As Long '最大行を格納する変数' | |
| Dim i As Long, j As Long 'forループで使う変数' | |
| Dim valueName As String '文字列を格納する変数' | |
| Dim boxNum As Long 'コンボボックスの番号,上から1,2,3' | |
| With UserForm1 | |
| lastRow = Cells(Rows.Count, 2).End(xlUp).Row '行数を取得' | |
| boxNum = 1 '一番上のコンボボックスから処理する' | |
| For i = 1 To 3 '1列目から3列目まで処理' | |
| Set checkDic = CreateObject("Scripting.Dictionary") '列ごとに初期化' | |
| .Controls("ComboBox" & boxNum).Clear 'リストをクリア' | |
| For j = 2 To lastRow | |
| valueName = Cells(j, i).Value 'j行i列のセルの値を取得' | |
| If Not checkDic.exists(valueName) Then 'Dictionaryで重複していないなら追加する' | |
| checkDic.Add valueName, "" 'Dictionaryに追加' | |
| .Controls("ComboBox" & boxNum).AddItem valueName 'コンボボックスに追加' | |
| End If | |
| Next j | |
| boxNum = boxNum + 1 '次のコンボボックスに変更' | |
| Set checkDic = Nothing '初期化' | |
| Next i | |
| End With | |
| End Sub | |
| 'コンボボックス1と連動してコンボボックス2のリストを作成する' | |
| Sub makeCombobox2() | |
| Dim checkDic As Object 'ディクショナリ' | |
| Dim lastRow As Long '最大行を格納する変数' | |
| Dim i As Long, j As Long 'forループで使う変数' | |
| Dim valueName As String '文字列を格納する変数' | |
| Dim boxNum As Long 'コンボボックスの番号,上から1,2,3' | |
| With UserForm1 | |
| lastRow = Cells(Rows.Count, 2).End(xlUp).Row '行数を取得' | |
| boxNum = 2 '2番目のコンボボックスから処理する' | |
| For i = 2 To 3 '2列目から3列目まで処理' | |
| Set checkDic = CreateObject("Scripting.Dictionary") '列ごとに初期化' | |
| .Controls("ComboBox" & boxNum).Clear 'リストをクリア' | |
| For j = 2 To lastRow | |
| If .ComboBox1.Value = Cells(j, 1) Then 'コンボボックス1の値と一致するなら処理' | |
| valueName = Cells(j, i).Value 'j行i列のセルの値を取得' | |
| If Not checkDic.exists(valueName) Then 'Dictionaryで重複していないなら追加する' | |
| checkDic.Add valueName, "" 'Dictionaryに追加' | |
| .Controls("ComboBox" & boxNum).AddItem valueName 'コンボボックスに追加' | |
| End If | |
| End If | |
| Next j | |
| boxNum = boxNum + 1 '次のコンボボックスに変更' | |
| Set checkDic = Nothing '初期化' | |
| Next i | |
| End With | |
| End Sub | |
| 'コンボボックス3を作成' | |
| Sub makeCombobox3() | |
| Dim checkDic As Object 'ディクショナリ' | |
| Dim lastRow As Long '最大行を格納する変数' | |
| Dim j As Long 'forループで使う変数' | |
| Dim valueName As String '文字列を格納する変数' | |
| Dim boxNum As Long 'コンボボックスの番号,上から1,2,3' | |
| With UserForm1 | |
| lastRow = Cells(Rows.Count, 2).End(xlUp).Row '行数を取得' | |
| boxNum = 3 '2番目のコンボボックスから処理する' | |
| Set checkDic = CreateObject("Scripting.Dictionary") '列ごとに初期化' | |
| .Controls("ComboBox" & boxNum).Clear 'リストをクリア' | |
| For j = 2 To lastRow | |
| If .ComboBox1.Value = Cells(j, 1) And .ComboBox2.Value = Cells(j, 2) Then 'コンボボックス1,2の値と一致するなら処理' | |
| valueName = Cells(j, 3).Value 'j行i列のセルの値を取得' | |
| If Not checkDic.exists(valueName) Then 'Dictionaryで重複していないなら追加する' | |
| checkDic.Add valueName, "" 'Dictionaryに追加' | |
| .Controls("ComboBox" & boxNum).AddItem valueName 'コンボボックスに追加' | |
| End If | |
| End If | |
| Next j | |
| Set checkDic = Nothing '初期化' | |
| End With | |
| End Sub | |
| '指定された学年と科目から科目番号を返す関数' | |
| Function subjectNum(grade As String, mainSubject As String, subSubject As String) As Long | |
| Dim lastRow As Long '行数を格納する変数' | |
| Dim i As Long 'forループで必要な変数' | |
| Dim result As Long | |
| lastRow = Cells(Rows.Count, 2).End(xlUp).Row '行数を取得' | |
| result = -1 '戻り値の初期値を-1(異常)とする' | |
| For i = 2 To lastRow | |
| If grade = Cells(i, 1) And mainSubject = Cells(i, 2) And subSubject = Cells(i, 3) Then | |
| result = Cells(i, 4) | |
| Exit For | |
| End If | |
| Next i | |
| subjectNum = result | |
| End Function |
※Gistのシンタックスハイライトが拡張子.dcmでは効かないため、Gistに登録したファイル名の拡張子を標準モジュールである.basに変更しています。
7.書いてるときに躓いたところ
If文の書き方やFor文の書き方などVBAの基本的な文法は省略しています。
ただ、私はIf文でEnd Ifを忘れたり、For文でNextを忘れたりしてめっちゃバグらせました。気をつけよう。
7-1.表の最終行、最終列の取得
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
Ctrl+矢印と同じ操作をして最終行/列のセルを取得するようです。RPAみたいで面白いと思いました。
7-2.Forループからの脱出
Exit For
break文ないのかよって思いました。
7-3.標準モジュールとブックモジュールとシートモジュール
- 標準モジュール: アクティブブックのアクティブシートを参照
- ブックモジュール: アクティブブックのアクティブシートを参照
- シートモジュール: シートモジュールが記述されているシートを参照
7-4.ユーザフォームの初期化
Initializeイベントを用います。
7-5.コンボボックスのイベント
色々あります。今回はチェンジイベントのみ使っています。
Private Sub ComboBox_Change()
"イベントが発生したときに行いたい処理を記述"
End Sub
ComboBoxの部分は、コンボボックスが複数ある場合には末尾に数字がつくので、処理を行いたいコンボボックスの名前を確認しておきましょう。
7-6.コンボボックスを連動させたい
上からリストを選択していくと、上のコンボボックスの内容に応じて次のコンボボックスの中身が変更されるようにしたい。実装は6-2を見てもらうので、やり方とロジックの説明を書きます。
- コンボボックスに入れたいデータの表を作ります。
- 各コンボボックスを先程作った表を使って初期化します。ただし、表には重複する部分があるのでDictionaryを使って重複を弾きます。
- 一番上のコンボボックスで表示されるリストは初期化されたまま使います。
- 一番上のコンボボックスの要素を選択したあと、その要素と表を比較して一致してる部分のリストを作成します。
- そのリストをチェンジイベントを用いて2番目のコンボボックスに適用します。
- 2番目のコンボボックスの要素を選択後、3番目のコンボボックスについて4,5と同じことをします。
8.VBAを書いた感想
できれば二度と書きたくない。GUIを簡単に作れるのは利点だが、PySimpleGUIを使った後だと逆にめんどくさい。
いい経験にはなったのが救い。