代码之家 › 专栏 › 技术社区 › Shiela

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

average listbox time vba excel

0

Shiela · 技术社区 · 2 年前

我这里有一张简单的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

我的帖子与几乎相同 this post 。但是对于我当前的帖子(这个问题),我在ID列中没有唯一的ID。ID可以在不同的Works中重复。

这是我的表格:

我已经使用下面的代码获得了每个作品的条目数(标签中)。

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

然而,对于上面表单图像中所需的输出,我不知道如何进行编码。

请告知。非常感谢。

1 回复 | 直到 2 年前

1

taller 2 年前

使用两个Dict对象汇总数据

Option Explicit

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Dim lastRow As Long, Work, Labels
    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")
    Labels = Array("lab_Carpenter", "lab_Painter", "lab_Dancer", "lab_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")
        ' Predefined lables name with array
        Me.Controls(Labels(i)).Caption = cntDict(key)
        ' If label controls name follow a pattern         
        ' Me.Controls("lab_" & key).Caption = cntDict(key)
    Next
    With Me.ListBox2
        .ColumnCount = 3
        .List = arrList
    End With
End Sub