Excel VBA表单：在列表框中展示含时间计算的唯一条目

背景与数据说明 #

已有两个表单，Form1的条目保存功能已完成且正常运行；需完成Form2的开发，从Sheet1读取数据并完成时间计算后，在两个列表框中展示结果。

Sheet1数据如下：

当前Form2代码框架 #

Private Sub UserForm_Initialize()
Dim colimplementationArea1 As Variant, colimplementationArea2 As Variant, colimplementationArea3 As Variant
Dim colStatus1 As Variant, colStatus2 As Variant, colStatus3 As Variant

Set Rng = Range("C:C") '项目ID
Set rng1 = Range("D:D") '实施区域
Set rng2 = Range("E:E") '开始时间
Set rng3 = Range("F:F") '结束时间
Set rng3 = Range("G:G") '状态

colimplementationArea1 = "Arizona"
colimplementationArea2 = "New York"
colimplementationArea3 = "Louisana"
colStatus1 = "For Approval 1"
colStatus2 = "For Approval 2"
colStatus3 = "COMPLETED"


'我缺少Listbox1和Listbox2的实现代码，用于从Sheet1读取数据并展示：

'--------Listbox1
'唯一Project ID | 实施区域 | 从For Approval 1到COMPLETED的总工时

'计算规则：
'***总工时为累加For Approval 1、For Approval 2、COMPLETED各状态段的结束时间与开始时间的时间差***



'--------Listbox2
'唯一实施区域 | 该区域所有唯一ID的总工时之和 | 平均工时

'计算规则：
'***以Sheet1数据为例，Arizona区域的两个唯一ID（1145544和1157788）的总工时相加后除以2；其余区域仅1个唯一ID，无需额外计算***


'抱歉...我实在不知道该如何编写列表框的计算代码
End Sub

补充实现代码 #

将以下代码插入到Form2的UserForm_Initialize过程中对应位置：

ListBox1 实现代码 #

'--------Listbox1 实现
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim projectDict As Object
Dim projectID As String
Dim area As String
Dim timeDiff As Double
Dim totalHours As Double

Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row '项目ID在B列，按需调整
Set projectDict = CreateObject("Scripting.Dictionary")

'设置ListBox1列属性
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "100,100,100"
ListBox1.AddItem "唯一Project ID"
ListBox1.List(0, 1) = "实施区域"
ListBox1.List(0, 2) = "总工时"

'遍历数据计算各项目总工时
For i = 2 To lastRow '跳过表头行
    projectID = ws.Cells(i, "B").Value
    area = ws.Cells(i, "C").Value
    '跳过午餐休息条目
    If projectID <> "LUNCH BREAK" Then
        '仅统计指定状态的时间差
        Select Case ws.Cells(i, "F").Value
            Case colStatus1, colStatus2, colStatus3
                timeDiff = ws.Cells(i, "E").Value - ws.Cells(i, "D").Value
                If projectDict.Exists(projectID) Then
                    projectDict(projectID) = Array(area, projectDict(projectID)(1) + timeDiff)
                Else
                    projectDict.Add projectID, Array(area, timeDiff)
                End If
        End Select
    End If
Next i

'填充ListBox1
For Each key In projectDict.Keys
    totalHours = projectDict(key)(1) * 24 '转换为小时数
    ListBox1.AddItem key
    ListBox1.List(ListBox1.ListCount - 1, 1) = projectDict(key)(0)
    ListBox1.List(ListBox1.ListCount - 1, 2) = Format(totalHours, "0.00") & " 小时"
Next key

ListBox2 实现代码 #

'--------Listbox2 实现
Dim areaDict As Object
Dim totalAreaHours As Double
Dim projectCount As Integer
Dim avgHours As Double

Set areaDict = CreateObject("Scripting.Dictionary")

'设置ListBox2列属性
ListBox2.ColumnCount = 3
ListBox2.ColumnWidths = "100,100,100"
ListBox2.AddItem "唯一实施区域"
ListBox2.List(0, 1) = "总工时之和"
ListBox2.List(0, 2) = "平均工时"

'基于ListBox1数据按区域分组计算
For i = 1 To ListBox1.ListCount - 1 '跳过表头行
    area = ListBox1.List(i, 1)
    totalHours = CDbl(Replace(ListBox1.List(i, 2), " 小时", ""))
    
    If areaDict.Exists(area) Then
        areaDict(area) = Array(areaDict(area)(0) + totalHours, areaDict(area)(1) + 1)
    Else
        areaDict.Add area, Array(totalHours, 1)
    End If
Next i

'填充ListBox2
For Each key In areaDict.Keys
    totalAreaHours = areaDict(key)(0)
    projectCount = areaDict(key)(1)
    avgHours = totalAreaHours / projectCount
    
    ListBox2.AddItem key
    ListBox2.List(ListBox2.ListCount - 1, 1) = Format(totalAreaHours, "0.00") & " 小时"
    ListBox2.List(ListBox2.ListCount - 1, 2) = Format(avgHours, "0.00") & " 小时"
Next key

'释放对象
Set projectDict = Nothing
Set areaDict = Nothing
Set ws = Nothing

注意事项 #

• 代码默认Sheet1表头在第1行，项目ID、实施区域等列索引需根据实际表格结构调整；
• 使用Scripting.Dictionary采用后期绑定，无需额外引用库；
• 时间差基于Excel时间格式（1天=1）计算，乘以24转换为小时数并保留两位小数展示。

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