请求编写月末自动填充指定单元格的Excel VBA脚本

以下是满足需求的VBA脚本，可自动将指定单元格的百分比数据记录到对应年份和月份的单元格中，保存后不会随原数据变动而更新：

核心代码 #

Sub RecordMonthEndPercentage()
    ' 定义变量
    Dim ws As Worksheet
    Dim percentageCell As Range
    Dim targetYear As Integer
    Dim targetMonth As String
    Dim yearRow As Range
    Dim monthColumn As Range
    Dim targetCell As Range
    
    ' 设置操作的工作表（可根据实际修改表名）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 设置百分比来源单元格（替换成你实际存放变动百分比的单元格地址）
    Set percentageCell = ws.Range("A1")
    
    ' 获取当前日期的年份和月份缩写（如JUL）
    targetYear = Year(Date)
    targetMonth = UCase(Format(Date, "mmm"))
    
    ' 查找对应年份的行
    Set yearRow = ws.Columns(1).Find(What:=targetYear, LookIn:=xlValues, LookAt:=xlWhole)
    If yearRow Is Nothing Then
        MsgBox "未找到年份：" & targetYear & "，请检查表格结构！", vbExclamation
        Exit Sub
    End If
    
    ' 查找对应月份的列
    Set monthColumn = ws.Rows(1).Find(What:=targetMonth, LookIn:=xlValues, LookAt:=xlWhole)
    If monthColumn Is Nothing Then
        MsgBox "未找到月份：" & targetMonth & "，请检查表格结构！", vbExclamation
        Exit Sub
    End If
    
    ' 定位到目标单元格（年份行 + 月份列交叉的单元格）
    Set targetCell = ws.Cells(yearRow.Row, monthColumn.Column)
    
    ' 将百分比值写入目标单元格（值传递，而非公式引用）
    targetCell.Value = percentageCell.Value
    ' 设置单元格格式为百分比（可选，根据你的需求调整）
    targetCell.NumberFormat = "0.00%"
    
    MsgBox "已成功记录" & targetYear & "年" & targetMonth & "月末百分比！", vbInformation
End Sub

代码说明 #

• 工作表与来源单元格：开头的ws和percentageCell需根据实际表格修改，比如数据在"月度记录"工作表、百分比在B2单元格，就改成Set ws = ThisWorkbook.Worksheets("月度记录")和Set percentageCell = ws.Range("B2")
• 年份与月份匹配：通过Find方法定位表格中的年份行和月份列，确保只匹配完全一致的内容
• 值传递：使用targetCell.Value = percentageCell.Value直接写入数值，而非公式引用，后续原百分比变动不会影响已记录的数据
• 格式设置：可选的百分比格式设置，确保显示符合需求

使用方法 #

1. 打开Excel文件，按下Alt + F11打开VBA编辑器
2. 在左侧工程窗口右键点击工作簿名称，选择插入 -> 模块
3. 将代码粘贴到新建模块中，根据表格修改工作表名和百分比来源单元格
4. 手动运行：回到Excel界面，按下Alt + F8，选择RecordMonthEndPercentage点击运行，即可记录当日对应月份的百分比

可选：设置自动运行（月末自动触发） #

如果希望每月月末自动执行脚本，可添加工作簿事件触发：

1. 在VBA编辑器左侧工程窗口双击ThisWorkbook
2. 顶部下拉菜单选择Workbook，再选择BeforeClose事件
3. 粘贴以下代码：

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 判断是否为月末最后一天
    If Day(Date) = Day(DateSerial(Year(Date), Month(Date) + 1, 0)) Then
        Call RecordMonthEndPercentage
    End If
End Sub

这样每次关闭工作簿时，若当天是月末最后一天，就会自动执行记录操作。

注意事项 #

• 确保表格的年份在第一列（A列）、月份缩写在第一行（1行），格式与代码匹配（年份为数字，月份为3位英文缩写如JAN、FEB）
• 首次运行前建议备份Excel文件，避免操作失误
• 如果表头月份是中文（如一月、二月），需修改代码中的targetMonth = Format(Date, "mmmm")，同时确保表头月份名称与之匹配

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