Question

我正在尝试使用大量文件（19 MB和40张）使用大量错误公式的公式获得runtime。

我尝试使用MS网站上的这个VBA代码来确定哪些公式导致了减速问题。但是，我是VBA的新手，这似乎无法正常工作。

https://msdn.microsoft.com/en-us/vba/excel-vba/articles/excel-improving-calcuation-performance

以下是代码：

    #If VBA7 Then
        Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
            "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
        Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
             "QueryPerformanceCounter" (cyTickCount As Currency) As Long
    #Else
        Private Declare Function getFrequency Lib "kernel32" Alias _                                            
            "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
        Private Declare Function getTickCount Lib "kernel32" Alias _
            "QueryPerformanceCounter" (cyTickCount As Currency) As Long
    #End If
    Function MicroTimer() As Double
    '

    ' Returns seconds.
        Dim cyTicks1 As Currency
        Static cyFrequency As Currency
        '
        MicroTimer = 0

    ' Get frequency.
        If cyFrequency = 0 Then getFrequency cyFrequency

    ' Get ticks.
        getTickCount cyTicks1

    ' Seconds
        If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
    End Function

    Sub RangeTimer()
        DoCalcTimer 1
    End Sub
    Sub SheetTimer()
        DoCalcTimer 2
    End Sub
    Sub RecalcTimer()
        DoCalcTimer 3
    End Sub
    Sub FullcalcTimer()
        DoCalcTimer 4
    End Sub

    Sub DoCalcTimer(jMethod As Long)
        Dim dTime As Double
        Dim dOvhd As Double
        Dim oRng As Range
        Dim oCell As Range
        Dim oArrRange As Range
        Dim sCalcType As String
        Dim lCalcSave As Long
        Dim bIterSave As Boolean
        '
        On Error GoTo Errhandl

    ' Initialize
        dTime = MicroTimer

        ' Save calculation settings.
        lCalcSave = Application.Calculation
        bIterSave = Application.Iteration
        If Application.Calculation <> xlCalculationManual Then
            Application.Calculation = xlCalculationManual
        End If
        Select Case jMethod
        Case 1

            ' Switch off iteration.

            If Application.Iteration <> False Then
                Application.Iteration = False
            End If

            ' Max is used range.

            If Selection.Count > 1000 Then
                Set oRng = Intersect(Selection, Selection.Parent.UsedRange)
            Else
                Set oRng = Selection
            End If

            ' Include array cells outside selection.

            For Each oCell In oRng
                If oCell.HasArray Then
                    If oArrRange Is Nothing Then
                        Set oArrRange = oCell.CurrentArray
                    End If
                    If Intersect(oCell, oArrRange) Is Nothing Then
                        Set oArrRange = oCell.CurrentArray
                        Set oRng = Union(oRng, oArrRange)
                    End If
                End If
            Next oCell

            sCalcType = "Calculate " &amp; CStr(oRng.Count) &amp; _
                " Cell(s) in Selected Range: "
        Case 2
            sCalcType = "Recalculate Sheet " &amp; ActiveSheet.Name &amp; ": "
        Case 3
            sCalcType = "Recalculate open workbooks: "
        Case 4
            sCalcType = "Full Calculate open workbooks: "
        End Select

    ' Get start time.
        dTime = MicroTimer
        Select Case jMethod
        Case 1
            If Val(Application.Version) >= 12 Then
                oRng.CalculateRowMajorOrder
            Else
                oRng.Calculate
            End If
        Case 2
            ActiveSheet.Calculate
        Case 3
            Application.Calculate
        Case 4
            Application.CalculateFull
        End Select

    ' Calculate duration.
        dTime = MicroTimer - dTime
        On Error GoTo 0

        dTime = Round(dTime, 5)
        MsgBox sCalcType &amp; " " &amp; CStr(dTime) &amp; " Seconds", _
            vbOKOnly + vbInformation, "CalcTimer"

    Finish:

        ' Restore calculation settings.
        If Application.Calculation <> lCalcSave Then
             Application.Calculation = lCalcSave
        End If
        If Application.Iteration <> bIterSave Then
             Application.Calculation = bIterSave
        End If
        Exit Sub
    Errhandl:
        On Error GoTo 0
        MsgBox "Unable to Calculate " &amp; sCalcType, _
            vbOKOnly + vbCritical, "CalcTimer"
        GoTo Finish
    End Sub

我一直收到语法错误。谢谢你的帮助！

Answer 1

<强>这里：

#If VBA7 Then
    Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
         "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
    Private Declare Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare Function getTickCount Lib "kernel32" Alias _
        "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If
Function MicroTimer() As Double


' Returns seconds.
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency
    '
    MicroTimer = 0

' Get frequency.
    If cyFrequency = 0 Then getFrequency cyFrequency

' Get ticks.
    getTickCount cyTicks1

' Seconds
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function

Sub RangeTimer()
    DoCalcTimer 1
End Sub
Sub SheetTimer()
    DoCalcTimer 2
End Sub
Sub RecalcTimer()
    DoCalcTimer 3
End Sub
Sub FullcalcTimer()
    DoCalcTimer 4
End Sub

Sub DoCalcTimer(jMethod As Long)
    Dim dTime As Double
    Dim dOvhd As Double
    Dim oRng As Range
    Dim oCell As Range
    Dim oArrRange As Range
    Dim sCalcType As String
    Dim lCalcSave As Long
    Dim bIterSave As Boolean
    '
    On Error GoTo Errhandl

' Initialize
    dTime = MicroTimer

    ' Save calculation settings.
    lCalcSave = Application.Calculation
    bIterSave = Application.Iteration
    If Application.Calculation <> xlCalculationManual Then
        Application.Calculation = xlCalculationManual
    End If
    Select Case jMethod
    Case 1

        ' Switch off iteration.

        If Application.Iteration <> False Then
            Application.Iteration = False
        End If

        ' Max is used range.

        If Selection.Count > 1000 Then
            Set oRng = Intersect(Selection, Selection.Parent.UsedRange)
        Else
            Set oRng = Selection
        End If

        ' Include array cells outside selection.

        For Each oCell In oRng
            If oCell.HasArray Then
                If oArrRange Is Nothing Then
                    Set oArrRange = oCell.CurrentArray
                End If
                If Intersect(oCell, oArrRange) Is Nothing Then
                    Set oArrRange = oCell.CurrentArray
                    Set oRng = Union(oRng, oArrRange)
                End If
            End If
        Next oCell

        sCalcType = "Calculate " & CStr(oRng.Count) & _
            " Cell(s) in Selected Range: "
    Case 2
        sCalcType = "Recalculate Sheet " & ActiveSheet.Name & ": "
    Case 3
        sCalcType = "Recalculate open workbooks: "
    Case 4
        sCalcType = "Full Calculate open workbooks: "
    End Select

' Get start time.
    dTime = MicroTimer
    Select Case jMethod
    Case 1
        If Val(Application.Version) >= 12 Then
            oRng.CalculateRowMajorOrder
        Else
            oRng.Calculate
        End If
    Case 2
        ActiveSheet.Calculate
    Case 3
        Application.Calculate
    Case 4
        Application.CalculateFull
    End Select

' Calculate duration.
    dTime = MicroTimer - dTime
    On Error GoTo 0

    dTime = Round(dTime, 5)
    MsgBox sCalcType & " " & CStr(dTime) & " Seconds", _
        vbOKOnly + vbInformation, "CalcTimer"

Finish:

    ' Restore calculation settings.
    If Application.Calculation <> lCalcSave Then
         Application.Calculation = lCalcSave
    End If
    If Application.Iteration <> bIterSave Then
         Application.Calculation = bIterSave
    End If
    Exit Sub
Errhandl:
    On Error GoTo 0
    MsgBox "Unable to Calculate " & sCalcType, _
        vbOKOnly + vbCritical, "CalcTimer"
    GoTo Finish
End Sub

Excel：测量计算时间的问题

1 个答案: