如何在没有唯一 ID 的情况下用平均总时间填充 ListBox2

Question

我这里有一个简单的 Excel 工作表，其中包含以下数据。

Excel 原始文本

YEAR    ID  Work        Time_In     Time_Out    Total_Hours
2023    111 Carpenter   11:00:00    12:00:00    1:00:00
2023    111 Painter     8:00:00     8:30:00     0:30:00
2023    112 Dancer      9:00:00     10:25:00    1:25:00
2023    113 Singer      10:00:00    11:10:00    1:10:00
2023    113 Singer      11:00:00    11:20:00    0:20:00
2023    113 Carpenter   13:00:00    13:10:00    0:10:00
2023    114 Painter     13:40:00    14:00:00    0:20:00
2023    114 Singer      14:40:00    15:35:00    0:55:00
2024    111 Carpenter   11:00:00    11:10:00    0:10:00

我的帖子与这篇帖子几乎相同。但对于我当前的帖子（这个问题），我在 ID 列中没有唯一的 ID。不同作品的 ID 可以重复。

这是我的表格：

我已经使用下面的代码成功获取了每个作品的条目数（在标签中）。

Option Explicit
Sub firstlistdisplay()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim Work() As Variant
    Dim Year() As Variant
    Dim i As Long, j As Long, k As Long
    Dim dict As Object, key As Variant
    
    Year = Array("2023", "2024")
    Work = Array("Carpenter", "Painter", "Dancer", "Singer")
    
    Set dict = CreateObject("Scripting.Dictionary") 'Initialize Dictionary
 
    Set ws = ThisWorkbook.Worksheets("Sheet2")

    lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row

    
    For i = 1 To lastRow
        key = ws.Cells(i, 1).Value & "_" & ws.Cells(i, 3).Value & "_" & ws.Cells(i, 2).Value
        If Not dict.Exists(key) Then
            dict.Add key, 1
        End If
    Next i
        For j = LBound(Year) To UBound(Year)
            Dim TotalCount As Long
            TotalCount = 0
            For k = LBound(Work) To UBound(Work) 'Loop through Work
                Dim iCarpenter As Long
                Dim iPainter As Long
                Dim iDancer As Long
                Dim iSinger As Long
                
                iCarpenter = 0
                iPainter = 0
                iDancer = 0
                iSinger = 0
                
                For Each key In dict.Keys
                    If InStr(key, "Carpenter") > 0 Then
                        iCarpenter = iCarpenter + 1
                    ElseIf InStr(key, "Painter") > 0 Then
                        iPainter = iPainter + 1
                    ElseIf InStr(key, "Dancer") > 0 Then
                        iDancer = iDancer + 1
                    ElseIf InStr(key, "Singer") > 0 Then
                        iSinger = iSinger + 1
                    End If
                Next key
                Me.Label1.Caption = iCarpenter
                Me.Label2.Caption = iPainter
                Me.Label3.Caption = iDancer
                Me.Label4.Caption = iSinger
            Next k
        Next j
End Sub

但是，对于上面的表单图像中所需的输出，我不知道如何编码。

请指教。谢谢..

Answer 1

• 使用两个Dict对象来汇总数据

Option Explicit

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Dim lastRow As Long, Work
    Dim arrList(), i As Long
    Dim cntDict As Object, sumDict As Object, key As Variant
    ' Label1~Label4 is in same order as Work
    Work = Array("Carpenter", "Painter", "Dancer", "Singer")
    Set cntDict = CreateObject("Scripting.Dictionary") 'Initialize Dictionary
    Set sumDict = CreateObject("Scripting.Dictionary")
    Set ws = ThisWorkbook.Worksheets("Sheet2")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For i = 1 To lastRow
        key = ws.Cells(i, 3).Value
        If Not cntDict.Exists(key) Then
            cntDict.Add key, 1
            sumDict.Add key, ws.Cells(i, 6).Value
        Else
            cntDict(key) = cntDict(key) + 1
            sumDict(key) = sumDict(key) + ws.Cells(i, 6).Value
        End If
    Next i
    ReDim arrList(cntDict.Count, 1 To 3)
    arrList(0, 1) = "Work"
    arrList(0, 2) = "Total_Hours"
    arrList(0, 3) = "Average"
    For i = 0 To UBound(Work)
        key = Work(i)
        arrList(i + 1, 1) = key
        arrList(i + 1, 2) = Format(sumDict(key), "h:mm:ss")
        arrList(i + 1, 3) = Format(sumDict(key) / cntDict(key), "h:mm:ss")
        Me.Controls("Label" & i + 1).Caption = cntDict(key)
    Next
    With Me.ListBox2
        .ColumnCount = 3
        .List = arrList
    End With
End Sub