VBA宏运行极慢耗时15分钟 排查代码性能瓶颈及优化方向

你的代码跑15分钟和工作表数据规模没有直接关系，这两个表的行数、列数属于极小的数据量，正常优化后耗时应该在1秒以内，慢的核心原因是几个极低效率的写法：

• 循环内残留了MsgBox (acte)弹窗代码：按你给的行数计算，外层双循环总共要执行近35万次，每一次都会弹出消息框阻塞代码运行，必须手动点击确认才会继续，这部分至少占了一半以上的耗时。
• 逐单元格直接操作工作表对象，没有做任何运行环境优化：VBA直接读写工作表单元格的速度比读写内存数组慢100~1000倍，你还在最内层嵌套了全表遍历：只要外层循环遇到非空的acte值，就会完整遍历gar_nv的2553行做判断，总单元格读取次数接近9亿次，开销极大。
• 大量冗余代码拖慢速度：比如每次循环都重复计算gar_nv的最后一行（这个值固定为2553，不需要反复算）、调用ColName函数做无意义的列号列名转换、给r/c/acte_next/Col_next等未使用的变量重复赋值读取单元格，平白增加了很多不必要的单元格操作。
• 没有关闭Excel的自动重算、屏幕刷新、事件触发：每次单元格值修改都会触发全局刷新、公式重算，进一步放大了耗时。

1. 第一步先删掉所有无用代码：直接删除MsgBox (acte)行，删除acte_next、Col_next的赋值语句，去掉r、c这类多余的中间变量，把gar_nv最后一行的计算移到循环外只算一次。
2. 代码运行前后加环境开关，运行时关闭屏幕刷新、自动计算、事件触发，运行结束无论是否报错都恢复默认设置，避免每次写单元格触发全局刷新。
3. 把两个工作表需要用到的数据区域一次性读入VBA内存数组，所有匹配判断逻辑都在内存里跑，不要在循环里读单元格；最后要写回gar_nv的结果也先存在数组里，全部逻辑跑完一次性写回表格，这一步改完耗时就能降到10秒以内。
4. 如果要进一步提速，用字典对象把gar_nv的匹配键（produit和acte的组合值）和对应行号提前存好，外层循环直接查字典定位目标行，不需要每次遍历全表，改完总耗时不会超过1秒。

Sub Remb()
    On Error GoTo ErrHandler
    ' 关闭环境开关
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Call Workbook_open
    Dim acte, Remb, Col, produit As Variant
    Dim colonne, ligne, Line, lastRow_gar As Long
    Dim arr_tg, arr_gar As Variant, dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 提前取gar_nv最后一行，只计算一次
    lastRow_gar = gar_nv.Cells(gar_nv.Rows.Count, 1).End(xlUp).Row
    ' 数据一次性读入内存数组
    arr_tg = tg.UsedRange.Value
    arr_gar = gar_nv.Range("A1:BQ" & lastRow_gar).Value ' 按gar_nv实际最大列号调整范围
    
    ' 构建匹配字典，key为GCGAR6列值&"|"&GCBARB列值，item为对应行号
    Const GCGAR6_COL As Long = 3 ' 替换成GCGAR6区域实际对应的列号
    Const GCBARB_COL As Long = 2 ' 替换成GCBARB区域实际对应的列号
    For Line = 1 To lastRow_gar
        dictKey = arr_gar(Line, GCGAR6_COL) & "|" & arr_gar(Line, GCBARB_COL)
        If Not dict.exists(dictKey) Then dict.Add dictKey, Line
    Next Line
    
    ' 遍历tg数据做匹配
    For colonne = col_dep To UBound(arr_tg, 2)
        For ligne = ligne_dep To nbrLines
            acte = arr_tg(ligne, colonne)
            If Not IsEmpty(acte) Then
                Remb = arr_tg(ligne, colonne - 1)
                Col = arr_tg(ligne, colonne + 1)
                produit = arr_tg(6, colonne)
                ' 直接查字典定位目标行
                dictKey = produit & "|" & acte
                If dict.exists(dictKey) Then
                    targetRow = dict(dictKey)
                    ' 如果Col存的是列字母，这里要提前转成数字列号，不要在循环内调用Columns对象转换
                    arr_gar(targetRow, CLng(Col)) = Remb
                End If
            End If
        Next ligne
    Next colonne
    
    ' 匹配结果一次性写回gar_nv工作表
    gar_nv.Range("A1:BQ" & lastRow_gar).Value = arr_gar

ErrHandler:
    ' 恢复Excel默认环境设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox Err.Description
End Sub

注意：代码里的GCGAR6_COL、GCBARB_COL常量需要替换成你表格里这两个命名区域实际对应的列号，如果Col变量存的是列字母而非数字列号，要提前在循环外写好批量转换逻辑，不要在循环里调用Columns对象做转换拖慢速度。

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