Question

首先，我要谢谢大家。我从提问和大家回答中学到了很多东西。我开始陷入循环的泥潭，但是我遇到了一个问题，即它们花费的时间太长了。我的下面的循环被要求执行两种不同的计算。第一个是百分比变化，另一个是4周的复合年增长率。这是代码：

Sub POSCAGR()

    Dim PSpark As Worksheet
    Dim lc As Long
    Dim lr As Long
    Dim qRng As Range
    Dim qCell As Range
    Dim rRng As Range
    Dim rCell As Range
    Dim i As Variant
    Dim j As Variant


'-------------------------------
'Set all variables

    Set PSpark = Worksheets("POS Trend")
    lc = PSpark.Cells(4, Columns.Count).End(xlToLeft).Column
    lr = PSpark.Cells(Rows.Count, "A").End(xlUp).Row
    Set qRng = PSpark.Range("Q4", ("Q" & lr)) 'range for q
    Set rRng = PSpark.Range("R4", ("R" & lr)) 'range for r

'------------------------------
'Calulate WoW changes and 4wk CAGR

        On Error Resume Next
        For Each qCell In qRng.Cells ' this will calculate the week over week changes
            For i = 4 To lr

                PSpark.Cells(i, "Q") = ((PSpark.Cells(i, lc).Value / PSpark.Cells(i, lc).Offset(0, -1).Value) - 1)
                PSpark.Range("Q4", ("Q" & lr)).NumberFormat = "0.0%"
                DoEvents


            Next i
        Next qCell
        On Error GoTo 0

        On Error Resume Next
         For Each rCell In rRng.Cells ' this will calculate a 4 wk CAGR
            For j = 4 To lr

                    PSpark.Cells(j, "R") = ((PSpark.Cells(j, lc).Value / PSpark.Cells(j, lc).Offset(0, -3).Value) ^ (1 / 3)) - 1
                    PSpark.Range("R4", ("R" & lr)).NumberFormat = "0.0%"
                    DoEvents

            Next j
        Next rCell
        On Error GoTo 0



End Sub

此循环必须遍历约600行数据，将来可能还要遍历。

任何帮助将不胜感激。

谢谢

海湾合作委员会

Answer 1

尝试一下。

与其将单个种子分配给一个单元，不如将数据放入数组中并一次将其输入到所有单元中。

Sub POSCAGR()

    Dim PSpark As Worksheet
    Dim lc As Long
    Dim lr As Long
    Dim qRng As Range
    Dim qCell As Range
    Dim rRng As Range
    Dim rCell As Range
    Dim i As Variant
    Dim j As Variant

    Dim vDB As Variant, vR As Variant
    Dim n As Long, c As Integer
'-------------------------------
'Set all variables

    Set PSpark = Worksheets("POS Trend")
    lc = PSpark.Cells(4, Columns.Count).End(xlToLeft).Column
    lr = PSpark.Cells(Rows.Count, "A").End(xlUp).Row
    'Set qRng = PSpark.Range("Q4", ("Q" & lr)) 'range for q
    Set qRng = PSpark.Range("Q4", ("r" & lr)) 'range for q & r
    'Set rRng = PSpark.Range("R4", ("R" & lr)) 'range for r
    With PSpark
        vDB = .Range("a4", .Cells(lr, lc))
    End With
    vR = qRng
    n = UBound(vDB, 1)
    c = UBound(vDB, 2)
'------------------------------
'Calulate WoW changes and 4wk CAGR
    For i = 1 To n
        vR(i, 1) = vDB(i, c) / vDB(i, c - 1) - 1 ' column q
        vR(i, 2) = ((vDB(i, c) / vDB(i, c - 3)) ^ (1 / 3)) - 1 'column r
    Next i
    qRng.NumberFormatLocal = "0.0%"
    qRng = vR


End Sub

循环执行时间过长

1 个答案: