如何修改VBA代码，在汇总每日最新时间时同步记录员工ID？

我有多个按日期命名的工作簿（如Workbook_20230505），数据格式如下：

现有一段VBA代码，可筛选排除Staff为SYSTEM或VOID的记录，将每日最新时间汇总到主工作簿，效果如下：

原代码如下：

Sub GetMax()
    Dim FolderPath As String
    Dim FileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim MaxValue As Date
    Dim DatePart As String
    Dim LastRow As Long
    Dim arr
    Application.ScreenUpdating = False
    ' Update your folder name
    FolderPath = "D:\Temp\"
    ' Clean activesheet and set format
    With ActiveSheet
        .UsedRange.Clear
        .[A1:B1].Value = Array("Date", "LatestTime")
        .Columns(1).NumberFormat = "mm/dd/yyyy"
        .Columns(2).NumberFormat = "h:mm:ss AM/PM"
    End With
    ' Retrieve files with "Workbook_*.xlsx"
    FileName = Dir(FolderPath & "Workbook_*.xlsx")
    Do While FileName <> ""
        DatePart = Split(FileName, "_")(1)
        Set wb = Workbooks.Open(FolderPath & FileName)
        Set ws = wb.Sheets(1)
        ' Get max value of column B
        arr = ws.UsedRange.Value
        MaxValue = 0
        If UBound(arr, 2) >= 3 Then
        For i = 2 To UBound(arr)
            If InStr("SYSTEM|VOID", UCase(arr(i, 3))) = 0 Then
                If MaxValue < arr(i, 2) Then MaxValue = arr(i, 2)
            End If
        Next
        End If
        wb.Close SaveChanges:=False
        With ThisWorkbook.Sheets(1)
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            If LastRow > 1 Or .Cells(LastRow, 1) <> "" Then LastRow = LastRow + 1
            .Cells(LastRow, "A").Value = DateSerial(CInt(Mid(DatePart, 1, 4)), CInt(Mid(DatePart, 5, 2)), CInt(Mid(DatePart, 7, 2)))
            .Cells(LastRow, "B").Value = MaxValue
        End With
        FileName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

需要修改代码，让主工作簿同时记录对应最新时间的Staff ID，期望格式如下：

Sub GetMaxWithStaffID()
    Dim FolderPath As String
    Dim FileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim MaxValue As Date
    Dim MaxStaffID As String ' 新增变量存储对应Staff ID
    Dim DatePart As String
    Dim LastRow As Long
    Dim arr
    Dim i As Integer ' 显式声明循环变量
    Application.ScreenUpdating = False
    ' 更新文件夹路径
    FolderPath = "D:\Temp\"
    ' 清理工作表并设置格式
    With ActiveSheet
        .UsedRange.Clear
        .[A1:C1].Value = Array("Date", "LatestTime", "Staff ID") ' 新增表头
        .Columns(1).NumberFormat = "mm/dd/yyyy"
        .Columns(2).NumberFormat = "h:mm:ss AM/PM"
        .Columns(3).NumberFormat = "@" ' 设置Staff ID为文本格式，避免长ID丢失精度
    End With
    ' 遍历目标文件夹下的工作簿文件
    FileName = Dir(FolderPath & "Workbook_*.xlsx")
    Do While FileName <> ""
        DatePart = Split(FileName, "_")(1)
        Set wb = Workbooks.Open(FolderPath & FileName)
        Set ws = wb.Sheets(1)
        ' 读取数据到数组提高效率
        arr = ws.UsedRange.Value
        MaxValue = 0
        MaxStaffID = "" ' 初始化Staff ID变量
        If UBound(arr, 2) >= 3 Then
            For i = 2 To UBound(arr)
                ' 排除SYSTEM和VOID的记录
                If InStr("SYSTEM|VOID", UCase(arr(i, 3))) = 0 Then
                    ' 找到更大的时间值时，同步更新时间和对应的Staff ID
                    If MaxValue < arr(i, 2) Then
                        MaxValue = arr(i, 2)
                        MaxStaffID = arr(i, 1)
                    End If
                End If
            Next
        End If
        wb.Close SaveChanges:=False
        ' 将结果写入主工作簿
        With ThisWorkbook.Sheets(1)
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            If LastRow > 1 Or .Cells(LastRow, 1) <> "" Then LastRow = LastRow + 1
            .Cells(LastRow, "A").Value = DateSerial(CInt(Mid(DatePart, 1, 4)), CInt(Mid(DatePart, 5, 2)), CInt(Mid(DatePart, 7, 2)))
            .Cells(LastRow, "B").Value = MaxValue
            .Cells(LastRow, "C").Value = MaxStaffID ' 写入Staff ID
        End With
        FileName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

• 新增变量MaxStaffID，用于存储最新时间对应的Staff ID
• 调整表头为三列，新增Staff ID列，并设置该列为文本格式，避免长ID丢失精度
• 在循环判断最大时间时，同步更新MaxStaffID为当前行的Staff ID
• 最后将MaxStaffID写入主工作簿的C列
• 显式声明循环变量i，符合VBA最佳实践

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