如何修改VBA代码，按合同日期与员工列筛选并汇总数据至主工作簿

核心修改要点 #

• 提取工作簿文件名中的日期（从Workbook_YYYYMMDD格式中提取8位日期字符串）
• 新增Contract Date列的筛选规则，要求该列值与工作簿日期匹配
• 调整数据读取起始行至第3行
• 指定主表汇总起始位置为C10，无对应工作簿的日期单元格保持空白

修改后的完整VBA代码 #

Sub 汇总最晚时间()
    Dim 主工作簿 As Workbook
    Dim 目标工作簿 As Workbook
    Dim 目标工作表 As Worksheet
    Dim 主工作表 As Worksheet
    Dim 文件路径 As String
    Dim 文件名 As String
    Dim 工作簿日期 As String
    Dim 数据区域 As Range
    Dim 筛选后数据 As Range
    Dim 最晚时间 As Date
    Dim 主表行号 As Integer
    
    ' 绑定主工作簿和主工作表，替换成你的主表实际名称
    Set 主工作簿 = ThisWorkbook
    Set 主工作表 = 主工作簿.Sheets("主表")
    主表行号 = 10 ' 汇总起始位置为C10
    
    ' 设置工作簿存放路径，替换成你的实际路径
    文件路径 = "C:\你的工作簿文件夹路径\"
    文件名 = Dir(文件路径 & "Workbook_*.xlsx")
    
    ' 遍历所有符合命名规则的工作簿
    Do While 文件名 <> ""
        ' 从文件名提取8位日期（Workbook_后的第1位到第8位）
        工作簿日期 = Mid(文件名, 10, 8)
        
        ' 打开目标工作簿并绑定数据工作表（假设数据在第一个工作表，可按需修改）
        Set 目标工作簿 = Workbooks.Open(文件路径 & 文件名)
        Set 目标工作表 = 目标工作簿.Sheets(1)
        
        ' 定义数据区域：从第3行开始，覆盖Staff、Contract Date和时间列
        ' 注：此处列范围需根据你的实际列位置调整，示例中为A到D列
        Set 数据区域 = 目标工作表.Range("A3:D" & 目标工作表.Cells(Rows.Count, "A").End(xlUp).Row)
        
        ' 清除原有筛选状态
        If 目标工作表.AutoFilterMode Then 目标工作表.AutoFilterMode = False
        
        ' 应用双重筛选：
        ' 1. Staff列（示例为B列）排除SYSTEM/VOID
        ' 2. Contract Date列（示例为C列）匹配工作簿日期
        数据区域.AutoFilter Field:=2, Criteria1:="<>SYSTEM", Operator:=xlAnd, Criteria2:="<>VOID"
        数据区域.AutoFilter Field:=3, Criteria1:=工作簿日期
        
        ' 获取筛选后的可见数据，避免无数据时报错
        On Error Resume Next
        Set 筛选后数据 = 数据区域.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        ' 初始化最晚时间变量
        最晚时间 = 0
        
        ' 遍历筛选后的时间列（示例为D列），找到最晚时间
        If Not 筛选后数据 Is Nothing Then
            Dim 单元格 As Range
            For Each 单元格 In 筛选后数据.Columns(4).Cells
                If IsDate(单元格.Value) And 单元格.Value > 最晚时间 Then
                    最晚时间 = 单元格.Value
                End If
            Next 单元格
        End If
        
        ' 将结果写入主表C列，无有效数据则留空
        主工作表.Cells(主表行号, "C").Value = IIf(最晚时间 <> 0, 最晚时间, "")
        
        ' 关闭目标工作簿，不保存修改
        目标工作簿.Close SaveChanges:=False
        
        ' 处理下一个文件，主表行号递增
        文件名 = Dir()
        主表行号 = 主表行号 + 1
    Loop
    
    MsgBox "汇总完成！"
End Sub

关键细节调整说明 #

1. 日期格式适配：如果你的Contract Date列是日期格式而非文本，需将提取的字符串转成日期类型，替换工作簿日期赋值行：

   工作簿日期 = CDate(Left(Mid(文件名,10,8),4) & "/" & Mid(Mid(文件名,10,8),5,2) & "/" & Right(Mid(文件名,10,8),2))
   

2. 列位置修改：代码中Field:=2（Staff列）、Field:=3（Contract Date列）、Columns(4)（时间列）需根据你的实际表格列位置调整
3. 空值处理：通过IIf函数直接对无数据的单元格赋值为空字符串，确保主表对应位置留空

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