如何通过VBA按钮将输入表日期匹配填充至对应Project_ID&Task的表格行

需求说明 #

• 输入表（单行多列结构）：包含Project ID、Check Point、Task、Date字段，示例数据：A123456、CP1、T1、11/14/23
• 目标表（Power Query生成）：包含project.Project_ID、project.City、project.State、Checkpoint、Task、Date字段，部分Date列值为空
• 核心需求：点击按钮后，将输入表的Date值填充到目标表中Project_ID与输入表Project ID完全匹配、Task与输入表Task完全匹配的行的Date列

VBA代码实现 #

打开Excel按Alt+F11打开VBA编辑器，插入新模块后粘贴以下代码：

Sub FillDateFromInputSheet()
    Dim inputWs As Worksheet, targetWs As Worksheet
    Dim inputLastRow As Long, targetLastRow As Long
    Dim i As Long, j As Long
    Dim inputProjID As String, inputTask As String, inputDate As Date
    
    ' 替换为你的实际工作表名称
    Set inputWs = ThisWorkbook.Worksheets("输入表")
    Set targetWs = ThisWorkbook.Worksheets("目标表")
    
    ' 获取输入表/目标表的最后数据行（假设表头在第1行）
    inputLastRow = inputWs.Cells(inputWs.Rows.Count, "A").End(xlUp).Row
    targetLastRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历输入表的每一条待填充记录
    For i = 2 To inputLastRow
        inputProjID = inputWs.Cells(i, "A").Value ' 输入表A列：Project ID
        inputTask = inputWs.Cells(i, "C").Value ' 输入表C列：Task
        inputDate = inputWs.Cells(i, "D").Value ' 输入表D列：待填充日期
        
        ' 遍历目标表查找匹配行
        For j = 2 To targetLastRow
            ' 目标表A列：project.Project_ID，E列：Task，F列：Date
            If targetWs.Cells(j, "A").Value = inputProjID And targetWs.Cells(j, "E").Value = inputTask Then
                targetWs.Cells(j, "F").Value = inputDate
                ' 若不想覆盖已有日期，可替换为：If targetWs.Cells(j, "F").Value = "" Then targetWs.Cells(j, "F").Value = inputDate
            End If
        Next j
    Next i
    
    MsgBox "日期填充完成！", vbInformation
End Sub

高效优化版本（大数据量适用） #

如果目标表数据量较大，上述双层循环效率偏低，可改用字典存储匹配关系提升速度：

Sub FillDateWithDictionary()
    Dim inputWs As Worksheet, targetWs As Worksheet
    Dim inputLastRow As Long, targetLastRow As Long
    Dim i As Long
    Dim matchKey As String
    Dim dateDict As Object
    
    Set dateDict = CreateObject("Scripting.Dictionary")
    Set inputWs = ThisWorkbook.Worksheets("输入表")
    Set targetWs = ThisWorkbook.Worksheets("目标表")
    
    inputLastRow = inputWs.Cells(inputWs.Rows.Count, "A").End(xlUp).Row
    targetLastRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row
    
    ' 将输入表的匹配规则存入字典：Key=ProjectID+Task（用|分隔避免冲突），Value=Date
    For i = 2 To inputLastRow
        matchKey = inputWs.Cells(i, "A").Value & "|" & inputWs.Cells(i, "C").Value
        dateDict(matchKey) = inputWs.Cells(i, "D").Value
    Next i
    
    ' 遍历目标表快速匹配填充
    For i = 2 To targetLastRow
        matchKey = targetWs.Cells(i, "A").Value & "|" & targetWs.Cells(i, "E").Value
        If dateDict.Exists(matchKey) Then
            targetWs.Cells(i, "F").Value = dateDict(matchKey)
            ' 可选：仅填充空值
            ' If targetWs.Cells(i, "F").Value = "" Then targetWs.Cells(i, "F").Value = dateDict(matchKey)
        End If
    Next i
    
    MsgBox "日期填充完成！", vbInformation
End Sub

按钮绑定步骤 #

1. 打开Excel「开发工具」选项卡（未显示可在「文件→选项→自定义功能区」中勾选）
2. 点击「插入」→ 选择「按钮（窗体控件）」，在工作表上绘制按钮
3. 在弹出的「指定宏」窗口中选择上述任意一个宏，点击确定
4. 修改按钮名称为「填充日期」即可使用

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