Excel VBA ADO循环

我的问题可能很简单，但我无法find合适的解决scheme。

我有几个Excel电子表格，第一个填写了一个具有唯一6位数字ID的列A.

然后，使用ADO连接，我需要从第二个电子表格（包含大量数据）获取与这些唯一ID中的每一个相对应的信息，

到目前为止，我执行下面的代码，但我很确定这不是最好的或最快的方式来做到这一点（因为它非常慢）

当然，我有一个没有ADO的VBA例程，但是信息量越来越大，很快就会成为一个问题。

希望ADO可以帮助我pipe理它，谢谢

Sub UpdateCurrentStatus() Dim sSQLQry As String Dim ReturnArray Dim Conn As New ADODB.Connection Dim mrs As New ADODB.Recordset Dim DBPath As String, sconnect As String Dim UID As String If MsgBox("Is the Labinal extract up-to-date?", vbYesNo) = vbNo Then Exit Sub Application.ScreenUpdating = False DBPath = Application.GetOpenFilename(Title:="Select second spreadsheet", FileFilter:="CSV (Comma delimited) (*.csv), *.csv") sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';FMT=Delimited(;)" Conn.Open sconnect y = 2 Do UID = ThisWorkbook.Worksheets("Sheet1").Cells(y, 1).Value sSQLSting = "SELECT [CurrentPhase] From [LabinalExtract$] where TicketReference =" & UID ' Your SQL Statement (Table Name= Sheet Name=[Sheet1$])" mrs.Open sSQLSting, Conn Sheets(1).Range("B2").CopyFromRecordset mrs mrs.Close y = y + 1 Loop While ThisWorkbook.Worksheets("Sheet1").Cells(y, 1) <> "" Conn.Close End Sub 

Answer 1

考虑避免任何循环，并简单地连接SQL中的两个工作簿，因为Windows的Jet / ACE引擎允许内联查询Excel工作簿，Access数据库甚至文本文件。

下面假设您的唯一ID的主工作簿中的列标题名为Sheet1名为Column1 （更改SQL的SELECT和ON子句）。 另外还不清楚您是否连接到CSV文件或Excel工作簿。 这假设都是Excel工作簿。

 ' CURRENT WORKBOOK CONNECTION (LAST SAVED STATE) xlConn.Open "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _ & "DBQ=" & ThisWorkbook.FullName & ";" ' JOIN QUERY WITH INLINE EXTERNAL CONNECTION sSQLSting = "SELECT t1.Column1, t2.[CurrentPhase]" _ & " FROM [Sheet1$] t1" _ & " INNER JOIN" _ & " (SELECT * FROM" _ & " [Excel 12.0 Xml;HDR=Yes;Database=" & DBPath & "].[LabinalExtract$]) t2" _ & " ON t1.Column1 = t2.TicketReference" ' OUTPUT QUERY RESULTS mrs.Open sSQLSting, xlConn Sheets(1).Range("B2").CopyFromRecordset mrs mrs.Close xlConn.Close 

Answer 2

我设法成功地调整了Parfait所提供的代码，现在正在工作，希望它可以帮助其他人

在行中要小心：

 & " [Excel 12.0 Xml;HDR=Yes;Database=" & DBPath & "].[Labinal]) t2" _ 

[Labinal]是指在Excel中命名的范围（表格）

其次在这一行：

 sSQLSting = "SELECT t2.[CurrentPhase]" _ 

你select你想返回的数据，在这种情况下，我将它缩小到我用作数据库的Excel文件中名为“当前阶段”的列（包括在范围名称中为“Labinal”）

这里最后的代码是：

 Sub UpdateCurrentStatus() Dim sSQLQry, sSQLSting As String Dim ReturnArray Dim Conn As New ADODB.Connection Dim mrs As New ADODB.Recordset Dim DBPath As String, sconnect As String If MsgBox("Is the Labinal extract up-to-date?", vbYesNo) = vbNo Then Exit Sub 'Application.ScreenUpdating = False DBPath = Application.GetOpenFilename(Title:="Selecciona el extracto de iMade", FileFilter:="Excel files (*.xlsx), *.xlsx") ' CURRENT WORKBOOK CONNECTION (LAST SAVED STATE) Conn.Open "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _ & "DBQ=" & ThisWorkbook.FullName & ";" ' JOIN QUERY WITH INLINE EXTERNAL CONNECTION sSQLSting = "SELECT t2.[CurrentPhase]" _ & " FROM [Sheet1$] t1" _ & " INNER JOIN" _ & " (SELECT * FROM" _ & " [Excel 12.0 Xml;HDR=Yes;Database=" & DBPath & "].[Labinal]) t2" _ & " ON t1.Column1 = t2.TicketReference" ' OUTPUT QUERY RESULTS mrs.Open sSQLSting, Conn Sheets(1).Range("B2").CopyFromRecordset mrs mrs.Close Conn.Close End Sub 

Answer 3

像这样尝试。 使用子程序。

 Sub myQuery() Dim y As Integer y = 2 Do UID = ThisWorkbook.Worksheets("Sheet1").Cells(y, 1).Value sSQLSting = "SELECT [CurrentPhase] From [LabinalExtract$] where TicketReference =" & UID ' Your SQL Statement (Table Name= Sheet Name=[Sheet1$])" y = y + 1 Loop While ThisWorkbook.Worksheets("Sheet1").Cells(y, 1) <> "" End Sub Sub UpdateCurrentStatus(sSQLQry As String) 'Dim sSQLQry As String Dim ReturnArray Dim Conn As New ADODB.Connection Dim mrs As New ADODB.Recordset Dim DBPath As String, sconnect As String Dim UID As String If MsgBox("Is the Labinal extract up-to-date?", vbYesNo) = vbNo Then Exit Sub Application.ScreenUpdating = False DBPath = Application.GetOpenFilename(Title:="Select second spreadsheet", FileFilter:="CSV (Comma delimited) (*.csv), *.csv") sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';FMT=Delimited(;)" Conn.Open sconnect mrs.Open sSQLSting, Conn Sheets(1).Range("B" & Rows.Count).End(xlUp)(2).CopyFromRecordset mrs mrs.Close Set mrs = Nothing Conn.Close End Sub