VBA与数据库——简化程序编写-查找

Sub DicSearch()
    Dim arr() As Variant
    '读取数据源
    arr = Range("A1").CurrentRegion.Value
    
    Dim dic As Object
    Set dic = VBA.CreateObject("Scripting.Dictionary")
    '记录到字典中
    Dim i As Long
    For i = 2 To UBound(arr)
        '这里直接记录数据所在的行号
        dic(VBA.CStr(arr(i, 1))) = i
    Next
    
    Dim des() As Variant
    '读取待查找的项目
    des = Range("D1").CurrentRegion.Value
    
    Dim irow As Long
    For i = 2 To UBound(des)
        irow = dic(VBA.CStr(des(i, 1)))
        If irow Then
            des(i, 2) = arr(irow, 2)
        End If
    Next
    '输出
    Range("D1").Resize(UBound(des, 1), UBound(des, 2)).Value = des
End Sub

dic(VBA.CStr(arr(i, 1))) = i

irow = dic(VBA.CStr(des(i, 1)))

Sub ADOSearch()
    Dim AdoConn As Object
    Set AdoConn = VBA.CreateObject("ADODB.Connection")
    
    '打开数据库
    AdoConn.Open "Provider =Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"
    Range("D2").CopyFromRecordset AdoConn.Execute("select A.项目,B.数据 from [Sheet1$D1:D3] A Left Join [Sheet1$A1:B5] B On A.项目=B.项目", , 1)

    AdoConn.Close
    Set AdoConn = Nothing
End Sub