基于Excel VBA的动态数据源提取及表间数据同步需求咨询

这个需求完全可以通过VBA实现，以下是分模块的代码方案，代码内添加了注释方便新手理解：

一、从可变文件名的源文件提取指定列到Sheet2 #

先插入表单控件按钮（开发工具→插入→表单控件按钮），关联下面的宏：

Sub 提取指定列到Sheet2()
    Dim 源文件路径 As String
    Dim 源工作簿 As Workbook
    Dim 源工作表 As Worksheet
    Dim 目标工作表 As Worksheet
    Dim 表头行 As Integer
    Dim 目标列数组 As Variant
    Dim 源列索引 As Integer
    Dim 目标列索引 As Integer
    
    ' 自定义要提取的表头名称，根据实际需求修改
    目标列数组 = Array("项目ID", "项目名称", "状态", "负责人", "进度", "备注")
    ' 设置表头所在行，一般为第1行
    表头行 = 1
    ' 绑定目标工作表（当前文件的Sheet2）
    Set 目标工作表 = ThisWorkbook.Sheets("Sheet2")
    ' 清空Sheet2原有数据，保留表头
    目标工作表.Rows(2 & ":" & 目标工作表.Rows.Count).Clear
    
    ' 弹出文件选择框，让用户选择每日生成的源文件
    源文件路径 = Application.GetOpenFilename("Excel文件 (*.xlsx;*.xls), *.xlsx;*.xls", , "请选择源数据文件")
    If 源文件路径 = "False" Then Exit Sub ' 用户取消选择则退出
    
    ' 后台打开源工作簿，不显示界面、只读模式
    Set 源工作簿 = Workbooks.Open(源文件路径, False, True)
    Set 源工作表 = 源工作簿.Sheets(1) ' 默认取源文件第一个工作表，可按需修改
    
    ' 遍历要提取的表头，找到对应列并复制到Sheet2
    For 目标列索引 = LBound(目标列数组) To UBound(目标列数组)
        On Error Resume Next
        ' 在源工作表表头行查找目标列的位置
        源列索引 = 源工作表.Rows(表头行).Find(What:=目标列数组(目标列索引), LookIn:=xlValues, LookAt:=xlWhole).Column
        On Error GoTo 0
        
        If 源列索引 > 0 Then
            ' 复制源列数据到Sheet2对应列
            源工作表.Columns(源列索引).Copy 目标工作表.Cells(1, 目标列索引 + 1)
        Else
            MsgBox "源文件中未找到表头：" & 目标列数组(目标列索引), vbExclamation
        End If
    Next 目标列索引
    
    ' 关闭源工作簿，不保存修改
    源工作簿.Close SaveChanges:=False
    MsgBox "数据提取完成！", vbInformation
End Sub

说明：若需要给不同工具创建对应参考工作表，只需复制上述代码，修改Set 目标工作表 = ThisWorkbook.Sheets("Sheet2")中的工作表名称（比如Set 目标工作表 = ThisWorkbook.Sheets("工具A数据")），再绑定新按钮即可。

二、Sheet1与Sheet2数据对比更新及高亮 #

再插入一个表单控件按钮，关联下面的宏：

Sub 对比更新Sheet1数据()
    Dim 主表 As Worksheet
    Dim 临时表 As Worksheet
    Dim 主表最后行 As Long
    Dim 临时表最后行 As Long
    Dim i As Long, j As Long
    Dim 项目ID As String
    Dim 查找结果 As Range
    Dim 高亮颜色 As Long
    
    ' 设置浅蓝色高亮的RGB值，可自行调整
    高亮颜色 = RGB(204, 255, 255)
    ' 绑定对应工作表
    Set 主表 = ThisWorkbook.Sheets("Sheet1")
    Set 临时表 = ThisWorkbook.Sheets("Sheet2")
    
    ' 获取两表最后一行的行号
    主表最后行 = 主表.Cells(Rows.Count, "A").End(xlUp).Row
    临时表最后行 = 临时表.Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 遍历Sheet2的每一行数据，从第2行开始跳过表头
    For i = 2 To 临时表最后行
        项目ID = 临时表.Cells(i, "A").Value
        If 项目ID <> "" Then
            ' 在Sheet1的A列查找匹配的项目ID
            Set 查找结果 = 主表.Columns("A").Find(What:=项目ID, LookIn:=xlValues, LookAt:=xlWhole)
            
            If Not 查找结果 Is Nothing Then
                ' 找到匹配项，对比其余列，这里对比B到G列，跳过E列
                For j = 2 To 7
                    If j <> 5 Then
                        If 主表.Cells(查找结果.Row, j).Value <> 临时表.Cells(i, j).Value Then
                            ' 内容有更新，高亮单元格
                            主表.Cells(查找结果.Row, j).Interior.Color = 高亮颜色
                        End If
                    End If
                Next j
            Else
                ' 未找到匹配项，在Sheet1新增行并复制指定列数据
                主表最后行 = 主表最后行 + 1
                ' 复制A:D列
                临时表.Cells(i, "A").Resize(1, 4).Copy 主表.Cells(主表最后行, "A")
                ' 复制F:G列
                临时表.Cells(i, "F").Resize(1, 2).Copy 主表.Cells(主表最后行, "F")
                ' 整行高亮
                主表.Rows(主表最后行).Interior.Color = 高亮颜色
            End If
        End If
    Next i
    
    MsgBox "数据对比更新完成！", vbInformation
End Sub

使用提示：

• 代码中的表头名称、列范围、RGB颜色值都可根据实际需求修改
• 运行前请确保Sheet1和Sheet2的表头一致，除了不需要的列
• 建议先备份文件再测试代码

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