Question

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

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

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

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

Answer 1

方法1。

如果在SQL上具有dbo，则创建一个临时表并在其中加载Excel数据。使用高效的字符串构建方法（例如，使用Mid代替而不是连续连接）一次完成该操作。或使用集成直接加载数据。运行查询并将数据放回去。找出需要格式化的单元格并立即进行处理（与Union循环以获得较大的范围）。

方法2。

使用客户端游标，从SQL加载所有数据，然后使用rs.Filter查找匹配的记录。您可以将Excel数据加载到数组或断开连接的记录集中，然后再放回去。

重要的是不要不必要地写回Excel。对Excel的写入不应超过两次。

类似（未经过完全测试的代码）

Dim rsLocal As ADODB.Recordset ' create a local, disconnected recordset
Set rsLocal = New ADODB.Recordset
rsLocal.CursorLocation = adUseClient
rsLocal.Fields.Append "L", adVarChar, 1024, adFldIsNullable ' change to suit your data
rsLocal.Open

Dim myRange As Range

rs.CursorLocation = adUseClient
'bring all the records back into memory
Set rs = GetData("SELECT 'Checked', AT.Code Code FROM astAssetTypes AT JOIN astAssetTypesUDFV UDFV ON UDFV.TableLinkId = AT.Id WHERE UDFV.Userfield13Id = '5029' AND AT.Code = '")


For Each c In sht.Range("J3:J" & lrow)
    rsLocal.AddNew
    If c.Value <> "" Then
        rs.Filter = "Code='" & c.Value & "'" 'use Filter to prevent lots of round trips
        If rs.RecordCount <> 0 Then
            rs.MoveFirst
            rsLocal("L") = rs("Code")

            'add the cells to the range as we go
            If myRange Is Nothing Then
                Set myRange = sht.Range(sht.cells(c.Row, "A"), sht.cells(c.Row, LCol))
            Else
                Set myRange = Union(sht.Range(sht.cells(c.Row, "A"), sht.cells(c.Row, LCol)), myRange)
            End If
        End If
    End If
    rsLocal.Update
Next

rsLocal.MoveFirst
sht.Range("L3").CopyFromRecordset rsLocal 'write all updates at once

With myRange.Font ' do all formatting at once
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.349986266670736
End With

Answer 2

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

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

2 个答案: