ユーザーフォームを使ったレコード抽出方法－基本－

ユーザーフォームを使って、データベースのコード列からコードを検索して、レコードを抽出する方法を紹介します。
活用例としては、ユーザーフォームで「社員コード」を選択して、抽出したレコードの各フィールドデータを各種書類に転記します。

これまで２回の内容は以下の事を紹介しました。

コンボボックスへの値の追加方法
コンボボックスからの値の取得方法
コマンドボタンのコード設定方法

VBAユーザーフォームとコンボボックス

ExcelVBAのユーザーフォームにおけるコンボボックスの値の追加方法と初期値の設定方法の基本について紹介しています。

ユーザーフォームとコンボボックスの値の取得

コンボボックスの値を取得するためのTextプロパティ、Valueプロパティ、Listプロパティ/ListIndexプロパティを紹介します。

今回は、最終回としてコンボボックスの値をキーにして、レコードを抽出する方法を紹介します。

コード①（コンボボックスへの値の追加）
1. コード概要（大まかな流れ）
  1. 社員コードの表記ゆれチェック
コード②（社員コードを検索キーにして行番号を取得）
1. コード概要（大まかな流れ）
  1. 社員コードの行番号の取得
  2. 変数Num1とNum2の大小を比較
コード③（コンボボックスで指定したレコードの出力）
1. コード概要（大まかな流れ）
まとめ

コード①（コンボボックスへの値の追加）

Private Sub UserForm_Initialize()
    Application.ScreenUpdating = False
    Dim MyDic As Object
    Set MyDic = CreateObject("scripting.dictionary") 'ディクショナリで社員コードの重複チェック
    Dim max As Long
    Dim i As Long
    Dim 社員コード As String
    Dim 社員コードvar As Variant
    ThisWorkbook.Sheets("社員データ").Activate
    If ThisWorkbook.Sheets("社員データ").AutoFilterMode = True Then 　　ThisWorkbook.Sheets("社員データ").Range("A1").AutoFilter
    max = ThisWorkbook.Sheets("社員データ").Cells(Sheets("社員データ").Rows.Count, "B").End(xlUp).Row '最終行取得「社員名列」を使用（社員コードの空白セル対応）
    ThisWorkbook.Sheets("社員データ").Range(Cells(1, "A"), Cells(max, "F")).Sort key1:=Sheets("社員データ").Range("A1"), order1:=xlAscending, Header:=xlYes '社員コードで昇順ソート
    '社員コードの重複削除
    For i = 2 To max
        社員コード = ThisWorkbook.Sheets("社員データ").Cells(i, 1).Value
        If 社員コード <> "" Then '社員コードが空欄でなければ
            If Not MyDic.exists(社員コード) Then '重複チェック（条件分岐：重複がなければ）
                MyDic.Add 社員コード, 社員コード 'ディクショナリに追加
            Else
                MsgBox "社員コードに重複があります。" & vbCrLf & "起動を終了します。" & vbCrLf & "社員コード" & 社員コード '重複メッセージ
                ThisWorkbook.Sheets("社員データ").Select
                Call 閉じるbtn_Click
                End
            End If
        Else
            MsgBox "社員コードが空欄のレコードがあります。" '社員コードが空白のメッセージ
            ThisWorkbook.Sheets("社員データ").Select
            Call 閉じるbtn_Click
            End
        End If
    Next i
        社員コードvar = MyDic.items 'Ａ列:社員コードリストを一旦バリアント変数に格納（ディクショナリが機能しないため）
        cb開始.List = 社員コードvar 'コンボボックス配列として値を追加
        cb終了.List = 社員コードvar
        cb開始.Text = 社員コードvar(0)
        cb終了.Text = 社員コードvar(0)
    Set MyDic = Nothing
    Application.ScreenUpdating = True
End Sub
'=====ユーザーフォームの起動====
Sub 台帳作成フォーム()
    台帳ファイル作成フォーム.Show
End Sub
'=====ユーザーフォームの終了====
Private Sub 閉じるbtn_Click()
    Unload 社員台帳作成フォーム
End Sub

コード概要（大まかな流れ）

（10行）社員コードを昇順でソート
（14行～31行）「社員コード」列の空白のチェック
（14行～31行）「社員コード」をディクショナリオブジェクトを使って重複削除
（32行～36行）「社員コード」の値をコンボボックスに追加

※データベースは「社員データ」シートにあります。

社員コードの表記ゆれチェック

社員コードをキーにして、行番号を取得するので上記１，２、３にあるようにA列を整形します。

ThisWorkbook.Sheets("社員データ").Range(Cells(1, "A"), Cells(max, "F")).Sort key1:=Sheets("社員データ").Range("A1"), order1:=xlAscending, Header:=xlYes

A列の昇順ソート

For i = 2 To max
        社員コード = ThisWorkbook.Sheets("社員データ").Cells(i, 1).Value
        If 社員コード <> "" Then '社員コードが空欄でなければ

ForNextステートメントで1行ずつ社員コードの空白をチェック

ForNextステートメントの基本的な使い方はこちらの記事で↓

10日で習得！VBA入門⑥繰り返し処理と最終行数取得

今回は繰り返し処理と最終行数の取得について紹介します。記事を読み進めていくことで、マクロVBAを使って同一シート内のデータ処理を自動化するために必要なVBAスキルを習得できます。VBA初学者が添付のレジュメを使って一緒に手を動かしながらVBAコードを記述していくことで、自分のペースでじっくり確実に習得することができます。

If Not MyDic.exists(社員コード) Then '重複チェック（条件分岐：重複がなければ）
                MyDic.Add 社員コード, 社員コード 'ディクショナリに追加

ディクショナリオブジェクトで重複削除

ディクショナリオブジェクトの基本的な使い方はこちらの記事で↓

VBAのDictionaryの基本的な使い方

データの重複削除（ユニーク化）をする場合にDictionaryオブジェクトを使う基本的な方法を簡潔に紹介しています。

コード②（社員コードを検索キーにして行番号を取得）

Private Sub 社員台帳作成btn_Click()
    Dim max As Long
    Dim Num1, Num2
    Dim i As Long
    If MsgBox(cb開始.Text & vbCrLf & "から" & vbCrLf & cb終了.Text & vbCrLf & "社員台帳を作成しますか？", vbYesNo + vbQuestion) <> vbYes Then Exit Sub '確認メッセージボックス
    ThisWorkbook.Sheets("社員データ").Activate
    max = ThisWorkbook.Sheets("社員データ").Cells(Sheets("社員データ").Rows.Count, "A").End(xlUp).Row '最終行取得
    '====フォームの開始コードと終了コードの行番号の取得===========
    For i = 2 To max
        If cb開始.Text = ThisWorkbook.Sheets("社員データ").Cells(i, "A").Value Then
            Num1 = i
            Exit For
        End If
    Next i
    For i = 2 To max
        If cb終了.Text = ThisWorkbook.Sheets("社員データ").Cells(i, "A").Value Then
            Num2 = i
            Exit For
        End If
    Next i
    '====変数Num1とNum2の大小を比較====
    If Num1 <> "" And Num2 <> "" Then 'コンボボックスが空欄ではなければ
        If Num1 < Num2 Then           'Num1よりNum2の数値が大きければ
            Call DataInput(Num1, Num2)
        ElseIf Num1 > Num2 Then       'Num2よりNum1の数値が大きければ
            Call DataInput(Num2, Num1)
        ElseIf Num1 = Num2 Then       'Num1とNum2の数値が同じならば
            Call DataInput(Num1, Num1)
        End If
    End If
    MsgBox cb開始.Text & vbCrLf & "から" & vbCrLf & cb終了.Text & vbCrLf & "社員台帳を作成しました。"
    ThisWorkbook.Sheets("取引成立台帳").Protect Mypass '「取引成立台帳」シート保護
    Unload 社員台帳作成フォーム
End Sub

コード概要（大まかな流れ）

（9行～20行）コンボボックスで指定した社員コード（開始・終了）の行番号を取得
（9行～20行）社員コード（開始と終了）の行番号を変数Num1とNum２に格納
（22行～29行）変数Num1とNum2の大小を比較してDataInputプロシージャに渡す

社員コードの行番号の取得

If cb開始.Text = ThisWorkbook.Sheets("社員データ").Cells(i, "A").Value Then
            Num1 = i

If cb終了.Text = ThisWorkbook.Sheets("社員データ").Cells(i, "A").Value Then
            Num2 = i

上記コードについては、IF関数を使って、コンボボックスの社員コードとデータベースのA列の社員コードが一致すれば、一致した行番号（開始行と終了行）を変数：Num1、Num２に格納しています。

変数Num1とNum2の大小を比較

If Num1 <> "" And Num2 <> "" Then 'コンボボックスが空欄ではなければ
        If Num1 < Num2 Then           'Num1よりNum2の数値が大きければ
            Call DataInput(Num1, Num2)
        ElseIf Num1 > Num2 Then       'Num2よりNum1の数値が大きければ
            Call DataInput(Num2, Num1)
        ElseIf Num1 = Num2 Then       'Num1とNum2の数値が同じならば
            Call DataInput(Num1, Num1)
        End If
End If

DataInputプロシージャに引数として変数：Num1とNum2を渡して、ForNextステートメントの初期値と最終値に使用します。

コード③（コンボボックスで指定したレコードの出力）

Sub DataInput(ByVal Lnum As Long, ByVal Unum As Long)
    Dim i As Long
    Dim Wd
    With Sheets("社員データ")
        For i = Lnum To Unum
            Wd = Array(.Cells(i, "A").Value, .Cells(i, "B").Value, .Cells(i, "C").Value, .Cells(i, "D").Value, .Cells(i, "E").Value, .Cells(i, "F").Value)
            Debug.Print Join(Wd, ",")
        Next i
    End With
End Sub