VBA仅向G列空白单元格填充佣金率公式至数据末行故障排查

问题背景 #

• 需求：G列存储合同全周期静态佣金率，部分单元格已有值、部分为空，仅需对G列空白单元格填充可变佣金率计算公式，填充范围覆盖至数据区域最末行
• 列规则：
  • G列：佣金率，原始导出数据中仅适用全周期静态佣金率的合同会在该列保留值
  • V列：协议签署日期
  • AA:AF列：协议生效后第1至第6年对应的年度佣金率，AA对应第1年、AB对应第2年，以此类推

原有代码问题 #

1. 公式赋值语法错误：VBA给单元格写入公式必须调用Range.Formula属性，原代码中y = Formula = "公式内容"属于连续布尔判断写法，不会执行公式写入操作
2. 单元格引用固定：循环遍历每行时，公式内V3、AA3这类引用没有跟随行号动态调整，所有空白单元格都会固定引用第3行数据，计算结果完全错误
3. 计算逻辑精度不足：直接用(TODAY()-日期)/365计算年度差会受闰年、大小月影响，存在计算偏差

修正后可运行代码 #

Sub Clean_Data()
    Dim lr As Long
    Dim y As Range
    Dim fillRng As Range
    ' 定位数据区域最后一行
    lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
    Set fillRng = Range("G3:G" & lr)
    
    For Each y In fillRng.Cells
        ' 仅处理空白单元格，跳过已有静态佣金率的行
        If Trim(y.Value) = "" Then
            ' 动态拼接当前行号，用DATEDIF计算精确年度差，INDEX+MATCH替代多层嵌套IF
            y.Formula = "=INDEX(AA" & y.Row & ":AF" & y.Row & ",MATCH(DATEDIF(V" & y.Row & ",TODAY(),""y""),{0,1,2,3,4,5},1))"
            
            ' 若要保留原有多层IF的逻辑，可注释上面的公式行，启用下面这行代码
            ' y.Formula = "=IF(AND(((TODAY()-V" & y.Row & ")/365)>=0,((TODAY()-V" & y.Row & ")/365)<=1),AA" & y.Row & ",IF(AND(((TODAY()-V" & y.Row & ")/365)>1,((TODAY()-V" & y.Row & ")/365)<=2),AB" & y.Row & ",IF(AND(((TODAY()-V" & y.Row & ")/365)>2,((TODAY()-V" & y.Row & ")/365)<=3),AC" & y.Row & ",IF(AND(((TODAY()-V" & y.Row & ")/365)>3,((TODAY()-V" & y.Row & ")/365)<=4),AD" & y.Row & ",IF(AND(((TODAY()-V" & y.Row & ")/365)>4,((TODAY()-V" & y.Row & ")/365)<=5),AE" & y.Row & ",AF" & y.Row & ")))))"
        End If
    Next y
End Sub

代码说明：

• 循环过程中自动拼接当前单元格行号，保证每行公式都引用本行的日期、年度佣金率数据
• DATEDIF(签署日期,TODAY(),"y")会返回两个日期之间的完整整年数，比直接除以365的计算精度更高
• INDEX+MATCH写法的公式更简洁，后续如果需要扩展更多年度的佣金率，只需要调整引用列范围和匹配数组即可，不需要叠加多层IF嵌套
• 增加Trim()判断，避免单元格内只有不可见空格时被误判为非空单元格跳过处理

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