Attribute VB_Name = "Mo_Search_Fast"
Option Compare Database
Option Explicit

Public dataDic_1 As Object
Public dataDic_2 As Object

Sub LoadDataIntoDictionary(trgTableName As String, _
                                            fieldName_1 As String, _
                                            fieldName_2 As String, _
                                            fieldName_3 As String)
    
    Dim sql As String
    Dim rs As DAO.Recordset
    Dim dataArray As Variant
    Dim i As Long
    Dim startTime As Double
    Dim endTime As Double

    ' 処理開始時間の記録
    startTime = Timer

    ' 必要な3つのフィールドを選択してデータを取得
    sql = "SELECT " & fieldName_1 & ", " & fieldName_2 & ", " & fieldName_3 & " "
    sql = sql & "FROM [" & trgTableName & "];"
    Set rs = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
    rs.MoveLast
    rs.MoveFirst
    Debug.Print rs.RecordCount
    ' レコードセットを配列に格納
    dataArray = rs.GetRows(rs.RecordCount)

    ' Dictionaryオブジェクトを作成
    Set dataDic_1 = CreateObject("Scripting.Dictionary")
    Set dataDic_2 = CreateObject("Scripting.Dictionary")

    ' 配列のデータをDictionaryに格納
    For i = LBound(dataArray, 2) To UBound(dataArray, 2)
        ' 各レコードをDictionaryに格納
        ' キー: フィールド1の値, 値: 配列(フィールド2の値, フィールド3の値)
        dataDic_1(CStr(dataArray(0, i))) = Array(dataArray(1, i), dataArray(2, i))
        dataDic_2(CStr(dataArray(1, i))) = Array(dataArray(2, i), dataArray(0, i))
    Next i

    ' リソースの解放
    rs.Close
    Set rs = Nothing

    ' 処理終了時間の記録
    endTime = Timer

    ' 処理時間の表示
    MsgBox "データの読み込みが完了しました。処理時間: " & (endTime - startTime) & " 秒", vbInformation
    
End Sub


' メモリ検索（超高速）
Function SearchInDictionary(trgDic As Object, _
                                            keyFieldValue As String) As Variant

    If trgDic.Exists(CStr(keyFieldValue)) Then
        Dim tmp As Variant
        tmp = trgDic(CStr(keyFieldValue))
        SearchInDictionary = tmp(0) & "：" & tmp(1)
    Else
        SearchInDictionary = Null
    End If
    
End Function

Private Sub Form_Load()
    
'    Call LoadDataToDictionary
    
    MsgBox "データを読み込みますので1分ほどお待ちください"
    Call LoadDataIntoDictionary("T_テストデータ - TM-WebTools", "メルアド", "乱数", "名前")

End Sub

Private Sub 検索_Click()
    
    Dim tmp As Variant
    
    tmp = SearchInDictionary(dataDic_1, "Y3YO029@test.jp")
    If Nz(tmp, "") = "" Then MsgBox "該当なし": Exit Sub
    MsgBox tmp
    
    tmp = SearchInDictionary(dataDic_2, "9800")
    If Nz(tmp, "") = "" Then MsgBox "該当なし": Exit Sub
    MsgBox tmp
    
End Sub