vba代码在excel中运行的代码太长（偏移量），无法填充工作表的行和列

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

有没有办法加快速度？ 罪犯是谁？ 顺便说一句，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

---

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

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

---

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

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

---

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

未经测试：

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

---

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

未经测试：

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

---

这不会发生在内存中，每次引用工作表都会减慢代码的速度。如果要加快速度，您需要使用变量数组并一次性将数组分配给范围。例如，您可以跳过整个循环并将每列作为一个整体分配：

ActiveSheet.range（“B16”）.Resize（TotalRecords）。Value=Application.Index（TagValues，0，cTagNo）

内存中不会发生这种情况，每次引用工作表时，都会减慢代码的速度。如果要加快速度，您需要使用变量数组并一次性将数组分配给范围。例如，您可以跳过整个循环并将每列作为一个整体分配：

ActiveSheet.range（“B16”）.Resize（TotalRecords）。Value=Application.Index（TagValues，0，cTagNo）