如何用VBA基于新增列和上月末日期调整库存表MTD Chg公式？

解决方案 #

先修正你代码里依赖Select/Activate的不良习惯（这会导致代码不稳定、效率低下），核心是通过动态定位上月最后一周的数据列来自动更新公式，完整实现如下：

核心逻辑

1. 直接定位"MTD Chg"列的位置，无需激活单元格
2. 遍历数据列的表头日期，筛选出属于上月的最后一列（即日期最大的上月数据列）
3. 用R1C1格式构建公式，让目标单元格自动引用上月最后列的对应行，减去最新添加的数据列

完整VBA代码

Sub Update_MTD_Chg_Formula()
    Dim ws As Worksheet
    Dim mtdChgCol As Long
    Dim dataColsRange As Range
    Dim lastMonthCol As Long
    Dim cell As Range
    Dim latestLastMonthDate As Date
    
    ' 绑定目标工作表，避免切换工作表出错
    Set ws = ThisWorkbook.Sheets("Summary")
    
    ' 定位"MTD Chg"列，无需激活单元格
    mtdChgCol = ws.Cells.Find(What:="MTD Chg", After:=ws.Range("A1"), _
        LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False).Column
    
    ' 定义数据列范围：表头行(第1行)从B列到MTD Chg列的左侧
    Set dataColsRange = ws.Range(ws.Cells(1, 2), ws.Cells(1, mtdChgCol - 1))
    
    ' 初始化上月最后日期变量
    latestLastMonthDate = DateSerial(Year(Date), Month(Date) - 1, 1)
    
    ' 遍历所有数据列表头，找到上月的最后一列
    For Each cell In dataColsRange
        If Month(cell.Value) = Month(Date) - 1 And cell.Value > latestLastMonthDate Then
            latestLastMonthDate = cell.Value
            lastMonthCol = cell.Column
        End If
    Next cell
    
    ' 定义需要更新公式的目标单元格范围（简化你的Union写法）
    Dim rwRng As Range
    Set rwRng = Union(ws.Range(ws.Cells(51, mtdChgCol), ws.Cells(54, mtdChgCol)), _
                      ws.Range(ws.Cells(58, mtdChgCol), ws.Cells(65, mtdChgCol)), _
                      ws.Range(ws.Cells(68, mtdChgCol), ws.Cells(69, mtdChgCol)))
    
    ' 用R1C1格式设置公式：自动引用上月最后列 - 最新数据列
    rwRng.FormulaR1C1 = "=RC[" & lastMonthCol - mtdChgCol & "] - RC[-1]"
End Sub

关键细节说明

• 适配动态列：不管"MTD Chg"列位置怎么变，或者上月最后周的列在哪，都能自动定位，不用硬编码列号
• 处理跨年度情况：如果当前是1月，Month(Date)-1会自动对应去年12月，VBA的DateSerial会自动处理年份切换
• 简化代码结构：把零散的Cells合并成连续区间，代码更易维护

注意事项

• 确保数据列的表头是标准日期格式（不是文本），否则Month函数无法正常识别日期
• 如果你的表头行不是第1行，需要把代码里的ws.Cells(1, ...)改成对应行号

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