ComboBox切换时计算ListBox时间列总和（结果异常）

我编写了ComboBox4的Change事件VBA代码，Excel工作表中存在格式为“hh:mm:ss”的Total Time列，希望计算ListBox中该列的时间总和并显示在表单的Label1中，但当前得到的求和结果不正确。

表单界面 #

Excel工作表数据说明 #

工作表中空白单元格有特定用途，原始数据如下：

Col. A         Col. B      Col. E       Col. G    Col. J           Col. L
YEAR      || NAME   || Total Time   || COLOR    || MONTH        || SHAPE
2023      || LINA   || 0:00:15      || GREEN    || AUGUST       || HEART
2023      || LINA   || 0:00:07      || GREEN    || SEPTEMBER    || CIRCLE
2024      || GARY   || 0:00:01      || GREEN    || SEPTEMBER    || DIAMOND
2024      || GARY   || 0:00:02      || GREEN    || SEPTEMBER    || RECTANGLE
2024      || GARY   || 0:00:15      || RED      || AUGUST       || OVAL
2023      || GARY   || 0:00:07      || RED      || AUGUST       || RECTANGLE
2023      || GARY   || 0:00:01      || GREEN    || AUGUST       || SQUARE
2024      || GARY   || 0:00:02      || GREEN    || SEPTEMBER    || STAR
2024      || TOM    || 0:00:15      || RED      || AUGUST       || HEART
2024      || TOM    || 0:00:07      || RED      || SEPTEMBER    || CIRCLE
2024      || TOM    || 0:00:01      || RED      || SEPTEMBER    || DIAMOND
2024      || TOM    || 0:00:02      || YELLOW   || SEPTEMBER    || OVAL
2024      || TOM    || 0:00:15      || YELLOW   || OCTOBER      || RECTANGLE
2024      || TOM    || 0:00:07      || YELLOW   || OCTOBER      || CIRCLE
2024      || TOM    || 0:00:01      || YELLOW   || OCTOBER      || SQUARE
2024      || TOM    || 0:00:02      || YELLOW   || OCTOBER      || STAR
2024      || TOM    || 0:00:15      || YELLOW   || OCTOBER      || STAR
2024      || TOM    || 0:00:07      || BLUE     || OCTOBER      || SQUARE

当前使用的ComboBox4代码 #

Option Explicit
Private Sub ComboBox4_Change()
    If Not ComboBox4.Value = "" Then
        Dim ws As Worksheet, rng As Range, count As Long, K As Long
        Dim arrData, arrList(), i As Long, j As Long
        Set ws = Worksheets("Sheet1")
        
        Dim countT As Date 'declared the variable here
        
        Set rng = ws.Range("A1:L" & ws.Cells(Rows.count, "B").End(xlUp).Row)
        arrData = rng.Value
        count = WorksheetFunction.CountIfs(rng.Columns(1), CStr(ComboBox2.Value), rng.Columns(2), ComboBox1.Value, rng.Columns(7), ComboBox3.Value, rng.Columns(10), ComboBox4.Value)
        ReDim arrList(1 To count + 1, 1 To UBound(arrData, 2))
        For j = 1 To UBound(arrData, 2)
            arrList(1, j) = arrData(1, j) 'header
        Next
        K = 1
                
        For i = 2 To UBound(arrData)
            If arrData(i, 2) = ComboBox1.Value And arrData(i, 1) = CStr(ComboBox2.Value) _
                And arrData(i, 7) = ComboBox3.Value And arrData(i, 10) = ComboBox4.Value Then
                K = K + 1
                
                countT = 0
                
                For j = 1 To UBound(arrData, 2)
                
                    countT = countT + arrData(i, 5) 'trying to get their total sum
                    
                    arrList(K, 5) = Format(arrData(i, 5), "hh:mm:ss")
                Next
                Label1.Caption = Format(CDate(countT), "hh:mm:ss") 'show total sum in this label in the form of hh:mm:ss
            End If
        Next
        With Me.ListBox1
            .ColumnHeads = False
            .ColumnWidths = "0,0,0,0,40,0,0,0,0,0,0,0"
            .ColumnCount = UBound(arrData, 2)
            .List = arrList
        End With
    End If
End Sub

问题分析与修正方案 #

错误点说明 #

1. countT初始化位置错误：每次匹配到符合条件的行就重置countT为0，导致无法累计所有符合条件行的时间总和。
2. 重复累加同一行时间：在列循环中反复执行时间累加操作，同一行的时间被重复加了多次（次数等于总列数），结果失真。
3. 结果更新时机错误：每处理一行就更新Label1，最终Label1仅显示最后一行的错误累加值，而非所有符合条件行的总和。

修正后的代码 #

Option Explicit
Private Sub ComboBox4_Change()
    If Not ComboBox4.Value = "" Then
        Dim ws As Worksheet, rng As Range, count As Long, K As Long
        Dim arrData, arrList(), i As Long, j As Long
        Set ws = Worksheets("Sheet1")
        
        Dim countT As Double '用Double存储时间总和，支持超过24小时的累计
        
        Set rng = ws.Range("A1:L" & ws.Cells(Rows.count, "B").End(xlUp).Row)
        arrData = rng.Value
        count = WorksheetFunction.CountIfs(rng.Columns(1), CStr(ComboBox2.Value), rng.Columns(2), ComboBox1.Value, rng.Columns(7), ComboBox3.Value, rng.Columns(10), ComboBox4.Value)
        ReDim arrList(1 To count + 1, 1 To UBound(arrData, 2))
        
        '填充表头
        For j = 1 To UBound(arrData, 2)
            arrList(1, j) = arrData(1, j)
        Next
        K = 1
        countT = 0 '总和变量仅初始化一次
        
        For i = 2 To UBound(arrData)
            If arrData(i, 2) = ComboBox1.Value And arrData(i, 1) = CStr(ComboBox2.Value) _
                And arrData(i, 7) = ComboBox3.Value And arrData(i, 10) = ComboBox4.Value Then
                K = K + 1
                
                '仅累加当前行的时间一次
                countT = countT + arrData(i, 5)
                
                '填充ListBox数据
                For j = 1 To UBound(arrData, 2)
                    If j = 5 Then
                        arrList(K, j) = Format(arrData(i, j), "hh:mm:ss")
                    Else
                        arrList(K, j) = arrData(i, j)
                    End If
                Next
            End If
        Next
        
        '所有行处理完成后，更新Label1的时间总和
        Label1.Caption = Format(countT, "[hh]:mm:ss")
        
        With Me.ListBox1
            .ColumnHeads = False
            .ColumnWidths = "0,0,0,0,40,0,0,0,0,0,0,0"
            .ColumnCount = UBound(arrData, 2)
            .List = arrList
        End With
    End If
End Sub

关键修正说明 #

• 改用Double类型存储时间总和：Excel中时间以小数形式存储（1天=1），Double类型可以支持超过24小时的累计，避免Date类型的循环限制。
• 调整countT初始化位置：放在外层循环之前，确保仅初始化一次。
• 移动时间累加操作：移出列循环，每一行仅累加一次时间值。
• 延迟Label1更新：所有符合条件的行处理完成后再更新标签内容，使用[hh]:mm:ss格式支持超过24小时的时间显示。

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