嘿，我来帮你解决这个效率瓶颈问题！你的双层循环耗时100秒的核心原因是逐单元格重复比对+O(n²)的时间复杂度——2000行的话，循环次数接近400万次，每次读写单元格都是VBA里最慢的操作之一。下面给你几个从快到更灵活的优化方案，总有一款适合你：

方法一：用字典（Dictionary）+ 数组实现O(n)时间复杂度（最快方案） #

这个思路是先把所有数据读到内存数组里（彻底避免频繁读写单元格），然后用A-H列的组合作为唯一键，把同组内B=501000和B=502000的M列值存到字典中，最后只需要遍历两次数据就能完成计算。

优化后的VBA代码： #

Sub CalculateRatioFast()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataArr As Variant
    Dim dict As Object
    Dim keyStr As String
    Dim i As Long
    
    ' 初始化工作表和数据范围
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 把A-M列数据读到内存数组（比直接读写单元格快100倍以上）
    dataArr = ws.Range("A2:M" & lastRow).Value
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 第一步：遍历数据，将同组的目标值存入字典
    For i = LBound(dataArr, 1) To UBound(dataArr, 1)
        ' 生成A-H列的唯一标识（用分隔符避免拼接冲突）
        keyStr = dataArr(i, 1) & "|" & dataArr(i, 3) & "|" & dataArr(i, 4) & "|" & _
                 dataArr(i, 5) & "|" & dataArr(i, 6) & "|" & dataArr(i, 7) & "|" & dataArr(i, 8)
        
        ' 按B列值分类存储M列数据
        Select Case dataArr(i, 2)
            Case 501000
                dict(keyStr & "_501") = dataArr(i, 13) ' M列是数组第13位（A为第1位）
            Case 502000
                dict(keyStr & "_502") = dataArr(i, 13)
        End Select
    Next i
    
    ' 第二步：遍历数据，计算比值并写入单元格
    For i = LBound(dataArr, 1) To UBound(dataArr, 1)
        If dataArr(i, 2) = 502000 Then
            keyStr = dataArr(i, 1) & "|" & dataArr(i, 3) & "|" & dataArr(i, 4) & "|" & _
                     dataArr(i, 5) & "|" & dataArr(i, 6) & "|" & dataArr(i, 7) & "|" & dataArr(i, 8)
            
            ' 检查字典中是否存在对应501000的数值
            If dict.Exists(keyStr & "_501") Then
                ws.Cells(i + 1, "P").Value = dataArr(i, 13) / dict(keyStr & "_501")
            End If
        End If
    Next i
    
    ' 清理对象释放内存
    Set dict = Nothing
    Set ws = Nothing
    MsgBox "计算完成！"
End Sub

为什么这个更快？ #

• 内存数组操作：彻底规避了原代码中数百万次的单元格读写（单元格IO是VBA性能杀手）。
• O(n)时间复杂度：只需要遍历数据两次，总循环次数仅4000次左右，比原代码快了1000倍！
• 字典快速查找：字典的键查找是近似O(1)的效率，比逐行比对快得多。

方法二：用Power Query（无需编程，可视化操作） #

如果你不想写VBA，Excel的Power Query是绝佳选择——它内置优化引擎，处理分组计算速度极快，操作全可视化：

1. 选中数据区域任意单元格，点击数据选项卡 → 从表格/区域（导入数据到Power Query编辑器）。
2. 在编辑器中选中A-H列，点击转换选项卡 → 分组依据：
   • 分组依据：勾选A-H所有列
   • 添加第一个聚合列：名称501_M，操作最大值，列M，条件B = 501000
   • 添加第二个聚合列：名称502_M，操作最大值，列M，条件B = 502000
3. 添加自定义列，公式：if [B] = 502000 then [502_M]/[501_M] else null
4. 点击关闭并上载，把结果导出到新工作表或覆盖原数据（记得先备份）。

这个方法的优势是零代码，处理2000行数据几乎瞬间完成，适合非编程用户。

方法三：用Excel公式（最简单，无需VBA） #

如果你偏好公式操作，可以先给每个A-H组生成唯一标识，再用查找函数匹配计算：

1. 在空白列（比如I列）生成组标识，I2单元格输入：

   =CONCAT(A2:H2)
   

   下拉填充到所有行。
2. 在P2单元格输入公式：

   =IF(B2=502000, M2/XLOOKUP(I2&"501000", I:I&B:B, M:M, ""), "")
   

   下拉填充到所有行。

兼容旧版本替代公式： #

如果你的Excel不支持XLOOKUP，可以用INDEX+MATCH组合：

=IF(B2=502000, M2/INDEX(M:M, MATCH(I2&"501000", I:I&B:B, 0)), "")

原代码的问题总结 #

1. 双层循环O(n²)复杂度：重复比对大量行，产生不必要的计算开销。
2. 频繁读写单元格：每次Cells(a, "A")都是一次磁盘IO，速度极慢。
3. 反向循环无意义：原代码从最后一行往前循环，但并没有利用反向循环的优势（比如删除行），反而增加了逻辑复杂度。

内容的提问来源于stack exchange，提问作者a.rathi