vba - 提高 VBA 的速度 - 应用程序不稳定

Question

我对 VBA 没有太多经验，因此需要这个社区的帮助来解决以下遇到的问题：

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

所以我很确定导致它变慢的原因是应用程序不稳定，但我并没有看到这一点。无论如何，我可以使用应用程序 volatile，或者我应该采取什么步骤让它运行得更快。我已经尝试了很多东西，但无济于事。我正在考虑完全删除这些函数并将公式添加到那些第 8 行单元格（绿色）。

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

截屏

标签： vbaexcel

Answer 1

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

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

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

你的信念是正确的，这会让Application.Volatile事情变慢。Using告诉 Excel，每当发生任何变化时Application.Volatile，它总是需要重新计算这个公式。

你是对的，目前，你的代码是如何格式化的，该功能需要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 的建议进行代码审查......