修正VBA代码：多工作簿按条件提取Staff ID与最新时间异常问题

问题根源 #

所有日期对应的Staff ID显示为最后一次迭代值，核心问题在于：

• 存储最新记录的变量未在每次处理新工作簿时重置，导致旧数据残留覆盖；
• 更新最新Contract Date时，未同步绑定对应Staff ID，最终仅保留最后一次循环的Staff ID值。

修正后的完整VBA代码 #

Sub ExtractLatestRecords()
    Dim wbSummary As Workbook
    Dim wsSummary As Worksheet
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim sourcePath As String
    Dim fileName As String
    Dim lastRowSource As Long
    Dim lastRowSummary As Long
    Dim i As Long
    Dim currentDate As Date
    Dim latestContractDate As Date
    Dim latestStaffID As String ' 存储对应最新日期的Staff ID
    Dim nameFilter As Variant
    Dim groupFilter As String
    
    ' 初始化汇总工作簿
    Set wbSummary = ThisWorkbook
    Set wsSummary = wbSummary.Sheets("汇总表") ' 替换为你的汇总表名称
    sourcePath = "C:\你的源文件路径\" ' 替换为实际工作簿存放路径
    
    ' 筛选条件：Name为SYSTEM/ALEX，Group为A
    nameFilter = Array("SYSTEM", "ALEX")
    groupFilter = "A"
    
    ' 遍历指定路径下的目标工作簿
    fileName = Dir(sourcePath & "Workbook_*.xlsx")
    Do While fileName <> ""
        ' 关键：每次处理新工作簿前重置变量，清空旧数据
        latestContractDate = #1/1/1900#
        latestStaffID = ""
        
        ' 打开源工作簿
        Set wbSource = Workbooks.Open(sourcePath & fileName)
        Set wsSource = wbSource.Sheets(1) ' 假设数据在第一个工作表，可按需修改
        
        ' 获取源数据最后一行
        lastRowSource = wsSource.Cells(Rows.Count, "A").End(xlUp).Row
        
        ' 遍历源数据行（表头在第1行，数据从第2行开始）
        For i = 2 To lastRowSource
            ' 检查是否符合筛选条件
            If (wsSource.Cells(i, "Name").Value = nameFilter(0) Or wsSource.Cells(i, "Name").Value = nameFilter(1)) And _
               wsSource.Cells(i, "Group").Value = groupFilter Then
               
                currentDate = CDate(wsSource.Cells(i, "Contract Date").Value)
                
                ' 更新最新日期及对应Staff ID
                If currentDate > latestContractDate Then
                    latestContractDate = currentDate
                    latestStaffID = wsSource.Cells(i, "Staff ID").Value
                End If
            End If
        Next i
        
        ' 仅当找到有效记录时写入汇总表
        If latestContractDate <> #1/1/1900# Then
            lastRowSummary = wsSummary.Cells(Rows.Count, "A").End(xlUp).Row + 1
            ' 从文件名提取日期（适配Workbook_YYYYMMDD格式）
            wsSummary.Cells(lastRowSummary, "A").Value = DateSerial(Left(Mid(fileName, 10), 4), Mid(Mid(fileName, 10), 5, 2), Right(Mid(fileName, 10), 2))
            wsSummary.Cells(lastRowSummary, "B").Value = latestContractDate
            wsSummary.Cells(lastRowSummary, "C").Value = latestStaffID
        End If
        
        ' 关闭源工作簿，不保存
        wbSource.Close SaveChanges:=False
        fileName = Dir()
    Loop
    
    MsgBox "数据提取完成！"
End Sub

关键修改说明 #

• 变量重置：每次循环处理新工作簿前，重置latestContractDate和latestStaffID，彻底清空上一个文件的残留数据；
• 同步绑定：更新最新Contract Date时，同步更新对应的latestStaffID，确保日期与Staff ID一一对应；
• 空值过滤：添加判断逻辑，仅在找到符合条件的记录时写入汇总表，避免产生空行。

使用注意事项 #

1. 替换代码中的C:\你的源文件路径\为实际存放工作簿的路径；
2. 确认汇总表名称为汇总表，若名称不同需修改对应代码；
3. 确认源数据的列名（Name、Group、Contract Date、Staff ID）与代码一致，若列名或位置不同，需调整wsSource.Cells(i, "列名")中的参数。

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