Excel VBA：B列单元格与偏移Y行值对比后填充P/Q列问题

原代码问题梳理 #

• 未读取A8单元格的偏移量Y值，变量Y无有效值
• 列号映射错误：P列对应列号16、Q列对应17、R列对应18，原代码使用的列号15、16、17完全不匹配目标列
• 循环范围逻辑混乱：反向遍历的起始、结束值计算错误，遍历的行范围不符合需求
• 匹配逻辑偏移计算错误：需求为当前行B列值 ↔ 当前行+Y行的B列值对比，原代码的偏移计算逻辑完全偏离需求
• 未做边界判断：如果当前行+Y超出有效数据范围，会出现引用空单元格的错误

修正后可运行代码 #

Sub FillPQByMatch()
    Dim Y As Long
    Dim lastRow As Long
    Dim iRow As Long
    ' 读取A8单元格的偏移量Y
    Y = Range("A8").Value
    ' 自动获取B列最后有数据的行，避免硬编码范围
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    ' 遍历范围：从B列第1行到 最后一行-Y（避免偏移后超出范围）
    For iRow = 1 To lastRow - Y
        ' 对比当前行B列 和 偏移Y行后的B列值
        If Cells(iRow, "B").Value = Cells(iRow + Y, "B").Value Then
            ' 相等则R列值填到P列
            Cells(iRow, "P").Value = Cells(iRow, "R").Value
            ' 可选：清空Q列原有值
            Cells(iRow, "Q").Value = ""
        Else
            ' 不等则R列值填到Q列
            Cells(iRow, "Q").Value = Cells(iRow, "R").Value
            ' 可选：清空P列原有值
            Cells(iRow, "P").Value = ""
        End If
    Next
End Sub

注意事项 #

• 如果需要反向遍历，只需要把循环语句修改为 For iRow = lastRow - Y To 1 Step -1 即可，不影响逻辑结果
• 代码自动识别B列的有效数据范围，不需要硬编码2502行的限制
• 你提供的示例中Y=2，代码运行后完全匹配你给出的期望输出结果

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