如何优化含COUNTIFS与XLOOKUP的Excel VBA宏运行效率

我刚开始学VBA宏，术语可能有问题请见谅。我录制的Excel宏能运行，但速度特别慢还偶尔崩溃，估计是宏里用的COUNTIFS和XLOOKUP公式的问题。想找下面代码里公式的高效写法：

原VBA代码 #

Dim lr As Long
lr = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row

    Range("H7").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIFS('Sheet1'!C[-7],Sheet2!RC[-7],'Sheet1!C[1],""*Text*""), ""Text"", ""Text"")"
    Range("H7").Select
    Selection.AutoFill Destination:=Range("H7:H" & lr)

    Range("K7").Select
    ActiveCell.Formula2R1C1 = _
        "=XLOOKUP(1,('Sheet1'!C[-10]=Sheet2!RC[-10])*('Sheet1!C[-1]=""Text""), 'Sheet1'!C[1], """")"
    Range("K7").AutoFill Destination:=Range("K7:K" & lr)

对应Excel公式 #

=IF(COUNTIFS('Sheet1'!A:A,Data!A7,'Sheet1'!I:I,"*Text*"), "Text", "Text")
=XLOOKUP(1,('Sheet1'!A:A=Sheet2!A7)*('Sheet1'!J:J="Text"), 'Sheet1'!L:L, "")

优化方案 #

核心优化点 #

1. 避免整列引用：原公式用A:A这类整列范围，会让Excel计算大量空单元格，大幅增加计算量，改用实际数据的有效范围。
2. 抛弃Select/AutoFill：录制宏生成的Select、ActiveCell操作是效率杀手，直接给目标区域批量写入公式即可。
3. 临时关闭Excel冗余功能：执行宏时关闭屏幕更新、事件触发，减少不必要的资源消耗。

优化后的VBA代码 #

Sub OptimizedFormulaMacro()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lr1 As Long, lr2 As Long
    Dim targetH As Range, targetK As Range
    
    ' 绑定工作表对象，避免重复查找和引用错误
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    
    ' 获取两个工作表的实际数据最后一行（如果第1行是表头，可调整起始行）
    lr1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
    lr2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
    
    ' 定义要写入公式的目标区域
    Set targetH = ws2.Range("H7:H" & lr2)
    Set targetK = ws2.Range("K7:K" & lr2)
    
    ' 临时关闭屏幕更新和事件，提升执行速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 批量写入COUNTIFS公式，用有效数据范围代替整列
    targetH.Formula = "=IF(COUNTIFS('Sheet1'!$A$2:$A$" & lr1 & ",Sheet2!A7,'Sheet1'!$I$2:$I$" & lr1 & ",""*Text*""), ""Text"", ""Text"")"
    
    ' 批量写入XLOOKUP公式，用有效数据范围代替整列
    targetK.Formula2 = "=XLOOKUP(1,('Sheet1'!$A$2:$A$" & lr1 & "=Sheet2!A7)*('Sheet1'!$J$2:$J$" & lr1 & "=""Text""), 'Sheet1'!$L$2:$L$" & lr1 & ", """")"
    
    ' 恢复Excel正常功能
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    ' 释放对象内存
    Set ws1 = Nothing
    Set ws2 = Nothing
End Sub

额外优化建议 #

如果数据量特别大（比如几万行），可以考虑用数组运算或者Power Query预处理数据，完全替代公式计算，效率会更高。但如果需要保留公式的动态更新能力，上面的代码已经能解决速度慢和崩溃的问题。

内容的提问来源于stack exchange，提问作者Simon