VBA宏计算与Excel公式插入

Question

我想问你这个问题：

我必须对一张客户表进行计算（假设这是一个SumIf公式，用于汇总另一张包含单个已注册交易的表中的付款）

我已经用宏完成了它，首先在未使用的列中插入一个sumif公式，然后将整个列的值复制到主表中，然后删除该公式。最后，数据是正确的，并且其中不包含一直运行的活动公式。

因此，对于这样的情况，我的问题是：哪种方法更有效：

我做的方式（宏用于插入公式，复制列，删除所有内容）

还是以其他方式在宏内进行计算？

Answer 1

我将随机值放在A1:F50000范围内。

以下是用于计算每行总和的4种不同方式的示例：

Formula:       211,6254      'Fill formula and replace with values (range)
LoopCells:     3909,2864     'Calculate each cell value (loop)
LoopWsFunc:    3103,0727     'Calculate each cell with worksheet function (loop)
LoopArray:     159,9878      'Calculate in array (read/write) at once

因此，实际上使用VBA和数组是最快的方法（在此测试案例中）。但这可能取决于您使用的公式以及工作表中有多少数据。为了确保针对您的特定情况使用最快的方法，请使用多种方法编写代码并测试哪种方法更快。

这是我使用的代码

Option Explicit

Public Sub TestFormula()
    Dim t As New cTimer
    t.StartCounter

    With Range("H1:H50000")
        .Formula = "=SUM(A1:F1)"  'write formula to all cells
        .Value = .Value           'replace formula by values
    End With

    Debug.Print "Formula:", t.TimeElapsed
End Sub


Public Sub TestLoopCells()
    Dim t As New cTimer
    t.StartCounter

    Dim iRow As Long
    For iRow = 1 To 50000   'calculate each cell by looping
        Cells(iRow, "H").Value = Cells(iRow, 1).Value + Cells(iRow, 2).Value + Cells(iRow, 3).Value + Cells(iRow, 4).Value + Cells(iRow, 5).Value + Cells(iRow, 6).Value
    Next iRow

    Debug.Print "LoopCells:", t.TimeElapsed
End Sub


Public Sub TestLoopWsFunc()
    Dim t As New cTimer
    t.StartCounter

    Dim iRow As Long
    For iRow = 1 To 50000   'Calculate each cell with sum function by looping
        Cells(iRow, "H").Value = WorksheetFunction.Sum(Range("A" & iRow & ":G" & iRow))
    Next iRow

    Debug.Print "LoopWsFunc:", t.TimeElapsed
End Sub


Public Sub TestLoopArray()
    Dim t As New cTimer
    t.StartCounter

    Dim InputArr() As Variant  'read data into array
    InputArr = Range("A1:F50000").Value

    ReDim OutputArr(1 To 50000, 1 To 1) As Variant 'generate output array

    Dim iRow As Long
    For iRow = 1 To 50000 'sum within the array
        OutputArr(iRow, 1) = InputArr(iRow, 1) + InputArr(iRow, 2) + InputArr(iRow, 3) + InputArr(iRow, 4) + InputArr(iRow, 5)
    Next iRow

    Range("H1:H50000").Value = OutputArr  'write the result from the array to the cells

    Debug.Print "LoopArray:", t.TimeElapsed
End Sub

用于测试性能的类模块cTimer

Option Explicit

Private Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type

Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Private m_CounterStart As LARGE_INTEGER
Private m_CounterEnd As LARGE_INTEGER
Private m_crFrequency As Double

Private Const TWO_32 = 4294967296# ' = 256# * 256# * 256# * 256#

Private Function LI2Double(LI As LARGE_INTEGER) As Double
Dim Low As Double
    Low = LI.lowpart
    If Low < 0 Then
        Low = Low + TWO_32
    End If
    LI2Double = LI.highpart * TWO_32 + Low
End Function

Private Sub Class_Initialize()
Dim PerfFrequency As LARGE_INTEGER
    QueryPerformanceFrequency PerfFrequency
    m_crFrequency = LI2Double(PerfFrequency)
End Sub

Public Sub StartCounter()
    QueryPerformanceCounter m_CounterStart
End Sub

Property Get TimeElapsed() As Double
Dim crStart As Double
Dim crStop As Double
    QueryPerformanceCounter m_CounterEnd
    crStart = LI2Double(m_CounterStart)
    crStop = LI2Double(m_CounterEnd)
    TimeElapsed = 1000# * (crStop - crStart) / m_crFrequency
End Property

^{来源：VBA Implementation of QueryPerformanceCounter}