如何修改VBA代码以基于预列日期提取最新时间及Staff ID

核心逻辑 #

遍历主工作表从C17开始的日期列表，针对每个日期：

• 构建对应工作簿名称（格式如Workbook_YYYYMMDD）
• 若工作簿存在，筛选出Staff列非SYSTEM/VOID的记录，提取最新Time及对应Staff ID
• 若工作簿不存在或无符合条件数据，对应单元格留空

修改后的VBA代码 #

Sub CompileLatestStaffData()
    Dim wsMain As Worksheet
    Dim lastRow As Long, i As Long
    Dim targetDate As Date
    Dim wbName As String
    Dim wbData As Workbook
    Dim wsData As Worksheet
    Dim dataLastRow As Long, j As Long
    Dim latestTime As Date
    Dim targetStaffID As String
    
    ' 指定主工作表，替换为你的实际表名
    Set wsMain = ThisWorkbook.Worksheets("主表")
    
    ' 获取C列日期列表的最后一行
    lastRow = wsMain.Cells(wsMain.Rows.Count, "C").End(xlUp).Row
    
    ' 从C17开始遍历每个日期
    For i = 17 To lastRow
        targetDate = wsMain.Cells(i, "C").Value
        ' 构建目标工作簿文件名（按需调整后缀）
        wbName = "Workbook_" & Format(targetDate, "YYYYMMDD") & ".xlsx"
        
        ' 初始化变量
        latestTime = 0
        targetStaffID = ""
        
        On Error Resume Next
        ' 尝试打开同路径下的目标工作簿
        Set wbData = Workbooks.Open(ThisWorkbook.Path & "\" & wbName)
        On Error GoTo 0
        
        If Not wbData Is Nothing Then
            ' 指定数据工作簿内的工作表，替换为实际表名
            Set wsData = wbData.Worksheets("数据")
            dataLastRow = wsData.Cells(wsData.Rows.Count, "Time").End(xlUp).Row
            
            ' 遍历数据行，筛选有效记录并找最新时间
            For j = 2 To dataLastRow ' 假设第一行是表头
                If wsData.Cells(j, "Staff").Value <> "SYSTEM" And wsData.Cells(j, "Staff").Value <> "VOID" Then
                    If wsData.Cells(j, "Time").Value > latestTime Then
                        latestTime = wsData.Cells(j, "Time").Value
                        targetStaffID = wsData.Cells(j, "Staff ID").Value
                    End If
                End If
            Next j
            
            ' 关闭数据工作簿，不保存
            wbData.Close SaveChanges:=False
            Set wbData = Nothing
        End If
        
        ' 将结果写入主表（时间写D列，Staff ID写E列，可按需调整）
        If latestTime <> 0 Then
            wsMain.Cells(i, "D").Value = latestTime
            wsMain.Cells(i, "E").Value = targetStaffID
        Else
            wsMain.Cells(i, "D").ClearContents
            wsMain.Cells(i, "E").ClearContents
        End If
    Next i
End Sub

关键调整说明 #

• 需替换代码中的"主表"和"数据"为你的实际工作表名称
• 若目标工作簿不在主文件同路径，修改ThisWorkbook.Path为实际文件路径
• 结果写入的列（当前为D、E列）可根据需求自行调整
• 代码会自动跳过无对应工作簿或无有效数据的日期，对应单元格保持空白

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