VBA记录集从单元格值循环

Question

我有一个查询表并转移到excel。我从单元格范围循环重新查询到数据库，它工作正常，但它真的花了很多时间，因为我使用下面的代码..代码需要查询和记录集每次满足每个单元格中的IF条件。还有其他方法可以在数据库服务器中执行此代码，一旦完成，只执行记录集吗？

     'Set Connection
      Set Cn = CreateObject("ADODB.Connection")
      Cn.Open "Driver={MySQL ODBC 5.3 ANSI Driver};Server=" & _
      Server_Name & ";Port=" & Port & ";Database=" & Database_Name & _
      ";Uid=" & User_ID & ";Pwd=" & Password & ";"

   'Set Recordset
    Set rs = CreateObject("ADODB.Recordset")

    rs.CursorLocation = 3
    rs.Open SQLQuery, Cn, adOpenStatic


    myArray = rs.GetRows()


    kolumner = UBound(myArray, 1) 'Count number of Columns
    rader = UBound(myArray, 2) 'count number of rows

    For K = 0 To kolumner ' Using For loop data are displayed
    Range("A5").Offset(0, K).Value = rs.Fields(K).Name 'Field is the header 
    of each column and not included in Array. Field(0) means header of first 
    column.

    For R = 0 To rader
        Range("A5").Offset(R + 1, K).Value = myArray(K, R)

    Next
    Next




    set rows = 0 to rader

    Range("L5").Value = "Debug Note" 'insert Name of Column

    For R = 6 To 1100

    Datevalue = Sheets("Sheet1").Range("I" & R)

    Dateexcel = FORMAT(Datevalue, "yyyy-MM-dd HH:mm:ss")
    SQLQuery2 = "SELECT * FROM Mfg.databasemodels_note " & _
                "where typeId = " & Sheets("Sheet1").Range("B" & R) & " AND 
                 date > " & "'" & Dateexcel & "'" & " order by date asc 
                 limit 1;"
    Set rs2 = CreateObject("ADODB.Recordset")
    rs2.CursorLocation = 3 'client
    rs2.Open SQLQuery2, Cn, adOpenStatic
    myArray2 = rs2.GetRows()


    If Not (rs2.BOF And rs2.EOF) And (Range("J" & R).Value = "failed" Or 
    Range("J" & R).Value = "invalid") Then
    Range("L" & R).Value = myArray2(3, 0)
    Else
    End If
    On Error Resume Next
    rs2.Close
    Set rs2 = Nothing

    Next