每隔两行插入行并计算配对数据差值的VBA代码问题排查

• 需求：多份Excel工作表存储了成对排列的行数据，需要对每一组数据执行后行减前行的数值计算（即第2行减第1行、第4行减第3行，依此类推），计算结果写入每组数据下方新插入的空白行中。
• 原始数据样例：
  
• 现有实现代码（VBA入门阶段编写）：

Sub test() Dim rng As Range
Columns(1).Insert
With Range("b2", Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
    .Formula = "=if(mod(row(),2)=1,1,"""")"
    .Value = .Value
    .SpecialCells(2, 1).EntireRow.Insert
End With
Columns(1).Delete
With Range("a1", Range("a" & Rows.Count) _
        .End(xlUp)(2)).Resize(, 3)
    .Columns(1).SpecialCells(4).Value = "Difference"
    Union(.Columns(2).SpecialCells(4), .Columns(3) _
    .SpecialCells(4)).Formula = _
    "=r[-1]c-r[-2]c"
End With
End Sub

• 运行异常：代码执行结果不符合预期，错误结果样例如下，无法正确计算成对行数据的差值：
  

原代码的核心问题是辅助列插行的判断逻辑错位：从B2开始给奇数行打标记插行的规则，和实际成对数据的分组位置不匹配，后续空行定位、公式相对引用的行号全部偏移，最终结果错位。

直接从数据末尾向前遍历处理，从根源上避免插行导致的行号偏移问题，不需要辅助列，逻辑更稳定：

Sub CalcPairDiff()
    Dim lastRow As Long, i As Long, calcCol As Long
    Application.ScreenUpdating = False
    ' 获取A列最后一行有效数据行号
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 从最后一对数据向前循环，步长设为2，插行不会影响未处理数据的位置
    For i = lastRow To 2 Step -2
        ' 在成对行下方插入1行空行
        Rows(i + 1).Insert
        ' 写入差值行标识
        Cells(i + 1, "A").Value = "Difference"
        ' 遍历需要计算差值的列，示例为B、C两列，可根据实际列数修改结束值
        For calcCol = 2 To 3
            ' 直接写入静态差值，如需保留公式可替换为 .FormulaR1C1 = "=R[-1]C-R[-2]C"
            Cells(i + 1, calcCol).Value = Cells(i, calcCol).Value - Cells(i - 1, calcCol).Value
        Next calcCol
    Next i
    
    Application.ScreenUpdating = True
End Sub

• 如果表格需要计算差值的列数更多，直接修改For calcCol = 2 To 3里的结束列号即可
• 如果需要差值随原数据动态更新，把计算行替换为公式写入的写法即可
• 代码会自动适配不同行数的工作表，不需要手动调整数据范围

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