如何在Excel ListBox中显示唯一Project ID及对应日期与完成状态

现有如下Excel表格数据，需要获取排除LUNCH BREAK的每个唯一Project ID对应的最后一条COMPLETED状态的Date、Project ID、Status列数据，并显示在UserForm的ListBox中：

Date      || Project ID || Implementation Area  || Start Time   || End Time     || Status
8/28/2023 || 1145544    || Arizona              || 8:00:03 AM   || 9:15:17 AM   || For Approval 1
8/28/2023 || 1157788    || Arizona              || 9:15:20 AM   || 12:00:19 PM  || For Approval 1
8/28/2023 ||LUNCH BREAK ||                      || 12:00:18 PM  || 1:00:00 PM   || LUNCH BREAK
8/29/2023 || 1145544    || Arizona              || 1:00:01 PM   || 3:00:00 PM   || For Approval 2
8/29/2023 || 1145544    || Arizona              || 3:30:07 PM   || 3:40:40 PM   || COMPLETED
8/30/2023 || 1157788    || Arizona              || 3:41:00 PM   || 3:50:00 PM   || For Approval 2
9/1/2023  || 1157788    || Arizona              || 4:00:00 PM   || 4:30:45 PM   || COMPLETED
9/2/2023  || 1233343    || New York             || 9:05:17 AM   || 11:30:20 AM  || For Approval 1
9/2/2023  ||LUNCH BREAK ||                      || 12:00:00 AM  || 1:00:00 PM   || LUNCH BREAK
9/2/2023  || 1233343    || New York             || 1:45:01 PM   || 2:45:30 PM   || For Approval 2
9/2/2023  || 1233343    || New York             || 3:00:00 AM   || 3:22:00 AM   || COMPLETED
9/2/2023  || 1422457    || Louisana             || 3:50:00 PM   || 4:12:00 PM   || For Approval 1
9/3/2023  || 1422457    || Louisana             || 10:18:03 AM  || 11:15:17 AM  || For Approval 2
9/4/2023  || 1422457    || Louisana             || 4:15:20 PM   || 4:35:19 PM   || COMPLETED

原VBA代码仅能提取C列唯一值且包含LUNCH BREAK，无法满足需求，期望输出如下：

Date         Project ID   Status
8/29/2023    1145544      COMPLETED
9/1/2023     1157788      COMPLETED
9/2/2023     1233343      COMPLETED
9/4/2023     1422457      COMPLETED

修改后的VBA代码 #

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim projectDict As Object
    Dim key As Variant
    Dim dateVal As String, projID As String, statusVal As String
    
    ' 设置目标工作表
    Set ws = Sheets("Sheet1")
    ' 获取数据区域的最后一行（避免遍历整列）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 创建字典存储每个项目的最新完成记录
    Set projectDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历数据行（从第2行开始，跳过表头）
    For i = 2 To lastRow
        projID = Trim(ws.Cells(i, "C").Value)
        statusVal = Trim(ws.Cells(i, "F").Value)
        
        ' 跳过LUNCH BREAK的行
        If projID <> "LUNCH BREAK" Then
            ' 仅处理状态为COMPLETED的记录
            If statusVal = "COMPLETED" Then
                dateVal = ws.Cells(i, "A").Value
                ' 字典键为Project ID，值拼接日期、项目ID、状态，后续拆分使用
                ' 按顺序遍历会自动覆盖旧记录，保留最后一条COMPLETED数据
                projectDict(projID) = dateVal & "|" & projID & "|" & statusVal
            End If
        End If
    Next i
    
    ' 配置ListBox的多列显示
    With Me.ListBox1
        .ColumnCount = 3
        .ColumnWidths = "100;100;100" ' 设置各列宽度，单位为磅
        ' 添加表头
        .AddItem
        .List(0, 0) = "Date"
        .List(0, 1) = "Project ID"
        .List(0, 2) = "Status"
    End With
    
    ' 将字典中的数据添加到ListBox
    i = 1
    For Each key In projectDict.Keys
        Dim dataArr As Variant
        ' 拆分存储的字符串为数组
        dataArr = Split(projectDict(key), "|")
        With Me.ListBox1
            .AddItem
            .List(i, 0) = dataArr(0)
            .List(i, 1) = dataArr(1)
            .List(i, 2) = dataArr(2)
        End With
        i = i + 1
    Next key
    
    ' 释放对象，避免内存泄漏
    Set projectDict = Nothing
    Set ws = Nothing
End Sub

代码关键点说明 #

• 字典去重并保留最新记录：利用Scripting.Dictionary的键唯一性，遍历数据时直接覆盖同项目的COMPLETED记录，最终保留每条项目的最后一条完成记录。
• 无效行过滤：直接判断Project ID是否为LUNCH BREAK，跳过此类无关行。
• ListBox多列优化：设置列数、列宽并添加表头，让数据展示更规整。
• 高效遍历：仅遍历到数据实际最后一行，避免整列遍历的冗余操作，提升运行效率。

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