首页 > 解决方案 > 对整个列执行一次查询,而不是遍历所有单元格

问题描述

我使用下面的循环遍历一列并对每个单元格值执行查询。鉴于此列中的单元格数量很容易超过 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 

标签: sqlsql-serverexcelvbaado

解决方案


方法一。

如果您在 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

推荐阅读