如何在不引用单元格 VBA 的情况下提高循环速度？答案

【问题标题】：How to improve loop speed without referencing cells VBA?如何在不引用单元格 VBA 的情况下提高循环速度？
【发布时间】：2022-01-13 23:08:42
【问题描述】：

我正在运行下面的代码从工作表中提取数据并将其吐出，它非常慢，有什么提高速度的想法吗？

这个循环本质上是从数组（从数据库）中提取数据

我已经完成了通常的关闭计算等操作，我正在寻找的是如何在不通过工作表单元格的情况下进行循环，因为我认为这需要很长时间。

谢谢！

代码如下：

    Set RawDataD1WS = PnLWB.Worksheets("Raw_Data_D1")
    Dim VarBunker As Variant
    
    
For i = LBound(VarBunker, 1) To UBound(VarBunker, 1)

    For k = LBound(VarBunker, 1) To UBound(VarBunker, 2)
    BunkerD1WS.Cells(k + 2, i + 1) = VarBunker(i, k)
    Next k

Next i

【问题讨论】：

VarBunker 是您使用 GetRows() 得到的数组吗？
是的，这是获取行位：Set rs = New ADODB.Recordset strSQL = "SELECT [External BA],[Origin],[DeliveredQuantity Total] from [Bunker_Deliveries$]" rs .Open strSQL, cn If rs.EOF = False Then VarBunker = rs.GetRows End If rs.Close
GetRows 中的二维数组是“翻转的”（如您所知），因此将其写入工作表的快捷方式是使用函数将数组转置到内存中，然后将其放在工作表。

标签： excel vba loops

【解决方案1】：

来自GetRows 的二维数组是“翻转的”（如您所知），因此将其写入工作表的最快方法是使用函数将数组转置到内存中，然后将其放置在工作表上。你可以使用Application.Transpose()，但这确实对它可以处理的数组的大小有限制，所以最好有自己的函数，这样你就不用考虑这个了。

Sub TestDrop()

    Dim oConn As New ADODB.Connection, arr
    Dim oRS As New ADODB.Recordset, strPath, n, ws As Worksheet

    strPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    
    oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & strPath
    
    Set oRS = oConn.Execute("select * from [TABLE1]")
    
    arr = oRS.GetRows()
    
    Set ws = ActiveSheet
    
    ws.Range("I1").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr ' "flipped"
    
    arr = XPose(arr)
    
    ws.Range("D1").Resize(UBound(arr, 1) + 1, UBound(arr, 2) + 1).Value = arr ' transposed
    

End Sub

'Transpose an array
Function XPose(arr)
    Dim lbr As Long, ubr As Long, lbc As Long, ubc As Long, r As Long, c As Long
    Dim arrOut
    lbr = LBound(arr, 1)
    ubr = UBound(arr, 1)
    lbc = LBound(arr, 2)
    ubc = UBound(arr, 2)
    ReDim arrOut(lbc To ubc, lbr To ubr)
    For r = lbr To ubr
        For c = lbc To ubc
            arrOut(c, r) = arr(r, c)
        Next c
    Next r
    XPose = arrOut
End Function

【讨论】：

试过这个方法，效果很好！感谢分享知识！

【解决方案2】：

将二维数组写入范围

如果您确定数组是从 0 开始的，则可以删除 LBounds。
如果您确定数组是从 1 开始的，则可以删除 LBound + 1s。

Set RawDataD1WS = PnLWB.Worksheets("Raw_Data_D1")
Dim VarBunker As Variant ' redim it and add some values to it

Dim rCount As Long: rCount = UBound(VarBunker, 1) - LBound(VarBunker, 1) + 1
Dim cCount As Long: cCount = UBound(VarBunker, 2) - LBound(VarBunker, 2) + 1

BunkerD1WS.Range("A2").Resize(rCount, cCount).Value = VarBunker

【讨论】：

我试试，谢谢！

【解决方案3】：

不要用户数组。 数组有范围的限制。您不能将 10000 行插入到数组中。而是执行以下操作：

Application.ScreenUpdating=false
Application.Calculate=XlCalculation.xlCalculationManual
Sheet1.EnableCalculation=False
' Your code
' ...
' Restore to defaults after processing

【讨论】：

“你不能在一个数组中插入 10000 行”——这是错误的。你从哪里得到的？