通过 VBA 宏实现 Excel 工时自动统计

数学困难的三金老师在工作中遇到一个费时费力的大困难场景：需要定期统计工作事项的投入时长，此事项具有以下特点：

需要在固定的模板中填写，模板见问题背景小节的图示
每项工作需要按日期分行，每行会有多个时间段，这些时间段会集中在一个单元格内
最后需要按天统计所有事项的时长（以分钟为单位）

问题背景

问题分析

不难看出，这实际上就是一个简单的时间计算问题，解决过程分解如下：

循环读取每一行，每个循环内做如下事情：
- 获取时间段
- 计算每个时间段的时长
- 计算此行累计时长，写入汇总单元格
对所有行的时长进行累加，得到总计时长，写入汇总单元格

如果每行只有一个时间段，那么用 Excel 的公式可以很简单的实现目的；但这个问题中，一个单元格内有多个时间段，需要先对时间段进行分离，对上述过程再进行分解：

循环读取每一行，每个循环内做如下事情：
- 在每个单元格内进行如下操作：
  - 循环读取时间段
  - 计算每个时间段的时长
- 计算此单元格累计时长，即为此行累计时长
- 将累计时长写入此行的汇总单元格
对所有行的时长进行累加，得到总计时长，写入汇总单元格

这使用公式难以实现；考虑到在 Excel 中，简单起见使用 VBA 宏实现。

代码

根据上一节的分析思路，需要实现几个子功能：

read_cell 读取单元格内容，输出时间段数据，可以用数组保存
time_calc 读取数组中的时间段数据，分别计算时长并累计
write_result 写入数据到单元格
sum_result 计算总计时长

2023/3/6 23:07 时间关系，今天先贴出全部代码，下次再根据功能分解，详细展开写写。

Sub work_calc()
    Dim my_rows As Integer
    Dim my_cols As Integer
    Dim str_temp As String

    Dim read_arr As Variant
    Dim time_arr As Variant
    Dim result_arr As Variant

    my_rows = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row
    my_cols = UsedRange.Columns.Count

    sum_total = 0

    For index_row = 3 To my_rows
        If Range("I" & index_row).Value <> "" Then
            str_temp = Range("I" & index_row).Value

            read_arr = read_cell(str_temp)

            result_arr = time_calc(read_arr)

            Range("E" & index_row) = sum_result(result_arr)

            sum_total = sum_total + sum_result(result_arr)
        End If
    Next

    Range("E" & my_rows + 1) = sum_total
End Sub

Function read_cell(cell_content As String) As Variant

    Dim var_split As Variant

    If InStr(cell_content, Chr(10)) > 0 Then
        var_split = Split(cell_content, Chr(10))
    Else
        var_split = Array(1)
        var_split(0) = cell_content
    End If

    read_cell = var_split

End Function

Function time_calc(time_arr As Variant) As Variant
    Dim time_split As Variant
    Dim result() As String
    k = 0

    For i = 0 To (UBound(time_arr) - LBound(time_arr))
        time_split = Split(time_arr(i), "-")
        ReDim Preserve result(0 To k)
        result(k) = Abs(DateDiff("n", TimeValue(time_split(1)), TimeValue(time_split(0))))
        k = k + 1
    Next

    time_calc = result

End Function

Function write_result(result_arr As Variant)
    Dim content As String
    content = ""

    For i = 0 To (UBound(result_arr) - LBound(result_arr))

        content = content & "" & CStr(result_arr(i))
        If i < (UBound(result_arr) - LBound(result_arr)) Then
            content = content + Chr(10)
        End If
    Next

    write_result = content

End Function

Function sum_result(result_arr As Variant)
    sum_temp = 0

    For i = 0 To (UBound(result_arr) - LBound(result_arr))
        sum_temp = sum_temp + result_arr(i)
    Next

    sum_result = sum_temp

End Function

运行结果

代码分析

TODO

本文采用署名-非商业性使用-相同方式共享 4.0 国际许可协议，转载请注明出处。