Question

我有一个Excel文件，我在其中设置了与Access数据库的连接。在Excel文件中，我在A列中有一个名称列表，我想在Access数据库中搜索这些名称，并从该数据库返回两个字段。我需要为大约200-300个名字做这个。

这是我的代码：

N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB

For i = 2 To N

    Dim rstTable As ADODB.Recordset
    Set rstTable = New ADODB.Recordset
    lookup = Range("A" & i).Value


    strSQL = "SELECT NAME1,NAME2 FROM DATA WHERE [Field2]= """ & lookup & """;"
    'Store query output
    rstTable.Open Source:=strSQL, ActiveConnection:=objConnection
    'Paste results to Transactions sheet
    Worksheets("Sheet1").Range("B" & i).CopyFromRecordset rstTable

    'Close the record set & connection
    rstTable.Close
    objConnection.Close
Next i

这可行（有点），但需要很长时间并随机崩溃。任何想法如何改善这个？

Answer 1

确保查找字段上有密钥会有所帮助。我建议制作工作簿的副本，并从Access或MS Query测试外部数据，看看它是否比VBA提供了性能提升。

使用MS Query或来自Access的数据时，您可以修改连接属性中的命令文本并使用？在where子句中指定工作表中的参数（这样你就不会失去该功能）。

Answer 2

我修改了你的SQL语句。将Where [Field2] = "xxx"替换为Where [Field2] IN ("xxx", "yyy", "zzz")。

N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB

For i = 2 To N
    lookup = lookup & "'" & Range("A" & i).Value & "', "
Next i
lookup = left(lookup, len(lookup) - 2)

Dim rstTable As ADODB.Recordset
Set rstTable = New ADODB.Recordset

strSQL = "SELECT NAME1,NAME2 FROM DATA WHERE [Field2] IN (" & lookup & ");"
'Store query output
rstTable.Open Source:=strSQL, ActiveConnection:=objConnection
'Paste results to Transactions sheet
Worksheets("Sheet1").Range("B" & i).CopyFromRecordset rstTable

'Close the record set & connection
rstTable.Close
objConnection.Close

Answer 3

在第一次迭代后关闭连接，因此下一次迭代（没有打开连接的代码）将失败。所以你应该将objConnection.Close移出循环。

但是，即便如此，使用IN (...)语法一次又一次地执行相同类型的查询，只需使用不同的参数即可完成：

' Declare all your variables
Dim N As Long
Dim strDB As String
Dim objConnection As ADODB.Connection
Dim rstTable As ADODB.Recordset
Dim strSQL As String

N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB

' collect the values in comma-separated string
lookup = ""
For i = 2 To N
    lookup = lookup & ",""" & Range("A" & i).Value & """"
Next i
' Chop off the first comma
lookup = Mid(lookup, 2)

' Perform a single query, but also select the Field2 value
Set rstTable = New ADODB.Recordset
strSQL = "SELECT Field2, NAME1,NAME2 FROM DATA WHERE [Field2] IN (" & lookup & ");"
' query output 
rstTable.Open Source:=strSQL, ActiveConnection:=objConnection

' Retrieve values 
While Not rstTable.EOF
    lookup = rstTable.Fields(0).Value
    ' Locate in which row to put the result
    For i = 2 To N
        If lookup = Range("A" & i).Value Then
            Range("B" & i).Value = rstTable.Fields(1).Value
            Range("C" & i).Value = rstTable.Fields(2).Value
        End If
    Next i
    rstTable.MoveNext
Loop    

' Close the record set & connection
rstTable.Close
objConnection.Close

Answer 4

你可以做你所描述的，但我认为在Access本身做这件事效率要高得多。只需使用您的名称创建一个表，然后对要查找2个字段的表执行内部联接。应该不到一分钟，可能不到30秒。

从超过一百万条记录中提取数据

4 个答案: