vba 代码耗时太长（偏移）在 excel 中运行的代码以填充工作表的行列答案

【问题标题】：vba code taking too long (Offset) Code running in excel to populate rows columns of worksheetvba 代码耗时太长（偏移）在 excel 中运行的代码以填充工作表的行列
【发布时间】：2018-06-25 20:48:33
【问题描述】：

我有以下代码从内存写入电子表格的行\列。如果有 200 条记录，则需要几分钟。我不明白为什么它应该那么慢，因为没有磁盘 I/O。一切都应该发生在记忆中。所以为什么要花几分钟让我很困惑。

关于如何使其更快的任何想法？ Offset是罪魁祸首吗？顺便说一句，TagValues 是一个二维数组。

Private Sub PopulateGrid()


    Dim i As Integer
    Dim r As Range
    Dim RowOffset As Integer
    Dim CurRow As Integer
    Dim StartCol As String

    RowOffset = 15
    StartCol = "B"

    MsgBox "Grid population will start after you press OK.  This might take a few minutes.  Please wait while we populate the grid.  You will be alerted when completed."

    Set r = ActiveSheet.Range("B16")

    For i = 1 To TotalRecords
        CurRow = RowOffset + i
        Set r = ActiveSheet.Range(StartCol + CStr(CurRow))
        r.Value = TagValues(i, cTagNo)

        Set r = r.Offset(0, 1)
        r.Value = Qty(i)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cSize)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cValveType)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cBodyStyle)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cPressureClass)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cOperator)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cEndConfiguration)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cPort)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cBody)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cTrim)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cStemHingePin)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cWedgeDiscBall)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cSeatRing)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cORing)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cPackingSealing)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cGasket)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cWarrenValveFigureNo)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cWarrenValveTrimCode)
        Set r = r.Offset(0, 1)
        r.Value = RemoveLastLineBreakAndTrim(TagValues(i, cComments))

        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cDelivery)

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = Price(i)

        Set r = r.Offset(0, 1)
        r.Value = ExtPrice(i)

    Next

    MsgBox "Grid Population completed."

End Sub

【问题讨论】：

这不会发生在内存中，每次引用工作表时都会减慢代码速度。如果您想加快速度，您将需要使用变体数组并一次将数组分配给范围。
例如您可以跳过整个循环并将每一列作为一个整体分配：ActiveSheet.Range("B16").Resize(TotalRecords).Value = Application.Index(TagValues,0,cTagNo)

标签： excel vba offset

【解决方案1】：

如果不查看您正在处理的数据，很难知道，但以下几点应该会有所帮助：

Sub test()

    ' Disable visual and calc functions
    ' So Excel isn't updating the display and
    ' recalculating formulas every time you
    ' fill another cell
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Instead of resetting r each time,
    ' Try more like this:
    Set r = ActiveSheet.Range(StartCol + CStr(CurRow))
    r.Value = TagValues(i, cTagNo)

    r.Offset(0, 1).Value = TagValues(i, cSize)
    r.Offset(0, 2).Value = TagValues(i, cValveType)
    r.Offset(0, 3).Value = TagValues(i, cBodyStyle)
    ' etc, etc, etc.
    ' Less steps for the processor
    ' Easier maintenance for you


    ' Enable visual and calc functions
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic   



End Sub

【讨论】：

【解决方案2】：

最快的方法是在内存中创建一个所需大小的二维数组，从源数据中填充它，然后将其直接放到工作表上。

未经测试：

Private Sub PopulateGrid()

    Const RowOffset As Long = 15
    Const StartCol As String = "B"
    Const NUMCOLS As Long = 5

    Dim i As Integer
    Dim arrOut()

    ReDim arrOut(1 To totalrecords, 1 To NUMCOLS)

    For i = 1 To totalrecords

        'shorter set of columns to illustrate the approach...
        arrOut(i, 1) = TagValues(i, cTagNo)
        arrOut(i, 2) = Qty(i)
        arrOut(i, 3) = TagValues(i, cSize)
        arrOut(i, 4) = TagValues(i, cValveType)
        arrOut(i, 5) = TagValues(i, cBodyStyle)

    Next

    ActiveSheet.Range("B16").Resize(totalrecords, NUMCOLS).Value = arrOut

End Sub

【讨论】：