Question

我对VBA没有太多经验，因此在遇到以下问题时需要此社区的帮助：

我在代码中使用了应用程序volatile来运行一系列计算，这大大减慢了它的速度。如果没有应用程序volatile，代码对于我的目的来说足够快，但是当我更改其中一个输入单元格时，不会计算/更新第8行（绿色行）。单元格E8（附加图像/绿色行）引用估计函数，该函数具有多种情况但在不使用应用程序易失性的情况下更改列E（或其他列）中的任何单元格时将不会更新。

所以我很确定导致它减速的是应用程序不稳定，但我不会在此看到。无论如何，我可以使用应用程序volatile，或者我应该采取什么步骤来使其运行得更快。我尝试过很多东西，但无济于事。我正在考虑完全删除这些函数，并为那些Row 8 Cells（绿色）添加公式。

Private Function EstimateFunctions(ByVal calc As String, Optional ByVal repdate As Date)

    'update1 As Range, update2 As Range

    Application.Volatile

    Dim rangeapproved As String
    Dim rangesum As String

    tempsum = 0

    Select Case calc

    Case "SumHrs"

        For n = 1 To 10 Step 1
            rangesum = "P" + CStr(n) + "_RESOURCE_HOURS"
            rangeapproved = "P" + CStr(n) + "_APPROVAL"

            If RangeExists(rangesum) = False Then Exit For

            If Range(rangeapproved).Value = "Y" Then
                temphrs = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
            Else
                temphrs = 0
            End If

            If temphrs = "-" Then temphrs = 0
            finalsum = finalsum + temphrs

        Next n

        If finalsum = 0 Then finalsum = ""
        EstimateFunctions = finalsum


    Case "SumQty"

        For n = 1 To 10 Step 1
            rangesum = "P" + CStr(n) + "_EXPENSE_QTY"
            rangeapproved = "P" + CStr(n) + "_APPROVAL"

            If RangeExists(rangesum) = False Then Exit For

            If Range(rangeapproved).Value = "Y" Then
                tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
            Else
                tempsum = 0
            End If

            If tempsum = "-" Then tempsum = 0
            finalsum = finalsum + tempsum

        Next n

        If finalsum = 0 Then finalsum = ""
        EstimateFunctions = finalsum


    Case "SumActuals"

        For n = 1 To 10 Step 1
            rangesum = "P" + CStr(n) + "_ACTUALS_SUMMARY"

            If RangeExists(rangesum) = False Then Exit For
            tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))

            If tempsum = "" Then tempsum = 0
            finalsum = finalsum + tempsum

        Next n

        EstimateFunctions = finalsum


    Case "SumDateActuals"

        For n = 1 To 10 Step 1
            rangesum = "P" + CStr(n) + "_ACTUALS_DATECOST"

            If RangeExists(rangesum) = False Then Exit For
            tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))

            If tempsum = "" Then tempsum = 0
            finalsum = finalsum + tempsum

        Next n

        EstimateFunctions = finalsum


    Case "SumPerformance"

        For n = 1 To 10 Step 1
            rangesum = "P" + CStr(n) + "_PERFORMANCE_SUMMARY"
            rangeapproved = "P" + CStr(n) + "_APPROVAL"

            If RangeExists(rangesum) = False Then Exit For

            If Range(rangeapproved).Value = "Y" Then
                tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
            Else
                tempsum = 0
            End If

            If tempsum = "" Then tempsum = 0
            finalsum = finalsum + tempsum

        Next n

        EstimateFunctions = finalsum


    Case "SumEarnedValue"

        For n = 1 To 10 Step 1
            rangesum = "P" + CStr(n) + "_EARNED_VALUE"
            rangeapproved = "P" + CStr(n) + "_APPROVAL"

            If RangeExists(rangesum) = False Then Exit For

            If Range(rangeapproved).Value = "Y" Then
                tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))
            Else
                tempsum = 0
            End If

            If tempsum = "-" Then tempsum = 0
            finalsum = finalsum + tempsum

        Next n

        EstimateFunctions = finalsum


    Case "SumPercentComplete"

        For n = 1 To 10 Step 1
            rangesum = "P" + CStr(n) + "_PERCENT_COMPLETE"
            rangeapproved = "P" + CStr(n) + "_BUDGET_SUMMARY"

            If RangeExists(rangesum) = False Then Exit For

            temp1 = WorksheetFunction.Index(Range(rangeapproved), 0, 3).Value
            temp2 = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))

            If temp2 = "" Then temp2 = 0

            tempsum = temp1 * temp2

            'If tempsum = "" Then tempsum = 0
            finalsum = finalsum + tempsum

        Next n

        If finalsum = 0 Then
            EstimateFunctions = ""
        Else
            EstimateFunctions = finalsum / WorksheetFunction.Index(Range("SUMMARY_BUDGET"), 0, 3)
        End If


    Case "SumActualExpense"

        For n = 1 To 10 Step 1
            rangesum = "P" + CStr(n) + "_ACTUAL_EXPENSES"

            If RangeExists(rangesum) = False Then Exit For

            tempsum = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))

            If tempsum = "" Then tempsum = 0
            finalsum = finalsum + tempsum

        Next n

        EstimateFunctions = finalsum


    Case "SumExpenseForecast"

        For n = 1 To 10 Step 1
            rangesum = "P" + CStr(n) + "_ACTUALS_SUMMARY"

            If RangeExists(rangesum) = False Then Exit For

            tempsum = WorksheetFunction.Index(Range(rangesum), 0, 4)

            If tempsum = "" Then tempsum = 0
            finalsum = finalsum + tempsum

        Next n

        EstimateFunctions = finalsum


    Case "SumCont"

        For n = 1 To 10 Step 1
            rangesum = "P" + CStr(n) + "_LABOUR_SUMMARY"

            If RangeExists(rangesum) = False Then Exit For

            tempsum = WorksheetFunction.Index(Range(rangesum), 0, 5)

            If tempsum = "" Then tempsum = 0
            finalsum = finalsum + tempsum

        Next n

        EstimateFunctions = finalsum

    End Select

End Function

截图

Screenshot

Answer 1

当我最近查看UDF的问题时，我找到了一个包含（半）有用信息here的页面。我只想强调一下：

为了正确计算，计算中使用的所有范围都应作为参数传递给函数。如果未将计算范围作为参数传递，则Excel不能在函数的VBA代码中引用范围，而是无法在计算引擎中考虑它们。

换句话说，Excel使用传递给函数的参数来确定何时需要重新计算。

你认为Application.Volatile正在减慢事情是正确的。使用Application.Volatile会告诉Excel 始终需要在任何更改时重新计算此公式。

您说得对，目前，您的代码的格式如何，该功能需要Application.Volatile才能保持更新。消除Application.Volatile的一种可能方法是将您的函数更改为需要所需的范围引用作为参数。如下所示：

Private Function EstimateFunctions(ByVal calc As String, ByVal rangesum as Range, Optional rangeapproved as Range, Optional ByVal repdate As Date)

每当您引用UDF中的范围，而不是作为传递给函数的参数时，Excel无法正确确定计算顺序的正确优先级，或者UDF依赖的其他范围。

至于确定是否可以重新编写代码以便将所有引用的范围作为参数传递是一种可行的解决方案 - 我会遵循Mathieu Guindon的建议转到Code Review ....

Answer 2

Application.Volatile并没有减慢代码速度，它只是告诉工作表在工作表中更改任何单元格时重新计算函数。代码运行速度一样快 - Application.Volatile只会让它运行得更频繁。

我可以想到两种避免Application.Volatile：

的方法

1）包括可能影响该功能的所有范围作为输入参数。然后Excel将根据依赖关系树知道何时重新计算。这可能不实用 - 看起来你的函数可能引用了100-200个命名范围。

2）使用工作表对象的Worksheet_Change事件。检查Target范围是否是感兴趣的范围（可能使用Application.Intersect），并调用宏来更新第8行。

您应该可以通过直接引用范围而不是使用WorksheetFunction.Index来加快代码速度。例如，更改

temphrs = WorksheetFunction.Index(Range(rangesum), 0, Application.Caller.Column - (WorksheetFunction.Index(Range(rangesum), 0, 1).Column - 1))

到

temphrs = Range(rangesum).cells(1, Application.Caller.Column - Range(rangesum).Column + 1)

提高VBA的速度 - 应用程序易变

截图

2 个答案: