对整个列执行一次查询，而不是遍历所有单元格

问题描述：

我使用下面的循环遍历一列，并对每个单元格值执行查询。鉴于此列中的单元格数量很容易超过10,000行，这不是一种非常快速的方法，因此我正在寻找另一种提高性能的方法。

I use the loop below to go through a column and perform a query for each cell value. Given the amount of cells in this column can easily exceed 10'000 rows, this is not a very fast method and therefore I am looking into another method for a performance boost.

我正在考虑用单元格的值填充数组，但是使用这种方法，很可能仍然有必要遍历所述数组并为每次迭代执行查询。

I am thinking about populating an array with the cells' values, but with this method it would most likely still be necessary to iterate through said array and perform the query for each iteration.

我不熟悉任何一种可能执行一次查询，或者至少大大提高此过程的性能的方法。有任何想法吗？

I am not familiar with any method to possibly execute the query once, or at least to significantly boost performance for this procedure. Any ideas?

Public Function getdata(query As String) As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim connstring As String
Set cnn = New ADODB.Connection

connstring = "Provider=SQLOLEDB;Data Source=noneofyourbusiness;Connect Timeout=180"
cnn.Open connstring

Set getdata = New ADODB.Recordset
    getdata.CursorLocation = adUseClient
getdata.Open query, connstring, 2, adLockReadOnly
End Function

Sub start()
'code...

For Each c In sht.Range("J3:J" & LRow)
    If Not c.Value = "" Then
        'Query
        Set rs = getdata("SELECT 'Checked' FROM astAssetTypes AT JOIN astAssetTypesUDFV UDFV ON UDFV.TableLinkId = AT.Id WHERE UDFV.Userfield13Id = '5029' AND AT.Code = '" & c.Value & "'")
        If Not rs.EOF Then
            sht.Cells(c.Row, "L").CopyFromRecordset rs
            With sht.Range(sht.Cells(c.Row, "A"), sht.Cells(c.Row, LCol)).Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.349986266670736
            End With
            rs.Close
        End If
    End If
Next c

'code...
End Sub

答

Sub start()

    Dim strCodes$, rng1 As Range, rng2 As Range, cell As Range

    '// Generate "IN" clause
    For Each c In sht.Range("J3:J" & LRow)
        If Len(c) > 0 Then
            strCodes = strCodes & "'" & c & "'" & IIf(c.Row = LRow, "", ",")
        End If
    Next

    'Query
    Set rs = getdata( _
        "SELECT 'Checked', AT.Code FROM astAssetTypes AT JOIN astAssetTypesUDFV UDFV ON UDFV.TableLinkId = AT.Id " & _
        "WHERE UDFV.Userfield13Id = '5029' AND AT.Code IN (" & strCodes & ");")
    While Not rs.EOF
        Set cell = sht.Columns("J:J").Find(rs("Code"), LookAt:=xlWhole)
        If Not cell Is Nothing Then
            If rng1 Is Nothing Then
                Set rng1 = sht.Cells(cell.Row, "L")
            Else
                Set rng1 = Union(rng1, sht.Cells(cell.Row, "L"))
            End If
            If rng2 Is Nothing Then
                Set rng2 = sht.Cells(cell.Row, "A").Resize(, LCol)
            Else
                Set rng2 = Union(rng2, sht.Cells(cell.Row, "A").Resize(, LCol))
            End If
        End If
        rs.MoveNext
    Wend

    '// Dump result
    rng1.Value = "Checked"
    With rng2.Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.349986266670736
        End With
    End With

End Sub

对整个列执行一次查询，而不是遍历所有单元格

相关推荐