Excel VBA 正确/高效的公式填充

Question

下午好，

我在 VBA 中开发解决方案已有 6 年了。我一路上学到的很多东西都是从那个时候得到的，所以我终于有机会说谢谢！

今天我得出的结论是，我需要发布一个困扰我多年的问题。所以 - 我在 VBA for Excel 中最常做的一件事是使用应用于相关范围的公式的结果填充定义的范围。到目前为止，我已经使用以下方法来完成此操作：

Sub CalculateField()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'''''''''''''''''''''''''''''''''
Dim RecordStop As Long

Set MyRange = ActiveSheet.Range("A:A")
RecordStop = Application.WorksheetFunction.CountA(MyRange)

'Apply Formula
Range("M2:M" & RecordStop).FormulaR1C1 = "=IF(RC[-7]=1,IF(ISERROR(VLOOKUP(CONCATENATE(RC[-2],""|"",1),R1C12:R[-1]C[-1],1,FA  LSE)),0,1),0)"

'Drop Formula, keep values
Range("M2:M" & RecordStop).Value = Range("M2:M" & RecordStop).Value

''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

我发现，虽然这种方法有效，但对于更大的文件/更复杂的公式，我在性能上的表现是巨大的！现在，我知道必须有一种更有效的方法来导出公式的结果并将它们直接注入希望结果作为值返回的工作表中。在上述方法中，我首先计算结果，然后用“值”（结果）覆盖“公式”。我目前正在处理一个需要 21 个计算字段并且平均在 100k 到 400k 记录之间的文件。

我担心现在是时候让我学习一种更好的方法，更专业的方法来做到这一点。我在这里和强大的谷歌搜索了如何做到这一点的例子。我在 SO 上找到了一些帖子，描述了我认为是解决方案的一部分，但是很难找到一个我可以遵循的具体简单示例来实施。我认为正确的方法涉及以下一项或全部：

1. 数组
2. 字典
3. 收藏

...我希望你们能指出我正确的方向。一旦解决了这个问题，我觉得这将大大提升我在 VBA 开发中的水平。由于我是自学成才，我一直犹豫是否要深入研究，并且从未真正想过我会做到这一点，因为这不是我的主要角色，但现在很想克服这个问题，因此我非常感谢您的帮助。

顺便说一句；我很擅长自学，所以如果碰巧已经有一个帖子可以让我到达那里，那就给我指明方向。同样，在搜索中我找不到我要找的东西，所以如果这是因为不知道如何（描述的词）寻找答案的结果，我深表歉意。

Answer 1

我可能会先从这个开始，然后再修补一堆。

如果您没有获得性能提升，那么我会考虑将您的源数据提取到数组中，在代码中修改它们，然后将您的结果写在一行代码中写回您的单元格。

这里有一个很好的使用 Array 路由的链接：VBA Arrays And Worksheet Ranges

Dim PrevCalc As XlCalculation
With Application
    PrevCalc = .Calculation
    .Calculation = xlCalculationManual
    .Cursor = xlWait
    .Calculate
    .EnableEvents = False
    .ScreenUpdating = False
End With
Dim RecordStop As Long

Set MyRange = ActiveSheet.Range("A:A")
RecordStop = Application.WorksheetFunction.CountA(MyRange)

'Apply Formula
With Range("M2:M" & RecordStop)
    .FormulaR1C1 = "=IF(RC[-7]=1,IF(ISERROR(VLOOKUP(CONCATENATE(RC[-2],""|"",1),R1C12:R[-1]C[-1],1,FA  LSE)),0,1),0)"

    'Calc only the target
    .Calculate

    'Drop Formula, keep values
    .Value = .Value
End With 'Range("M2:M" & RecordStop)

With Application
    .Cursor = xlDefault
    .Calculate
    .Calculation = PrevCalc
    '.ScreenUpdating = True 'Not Needed...
    .EnableEvents = True
End With