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

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

问题背景

工时统计模板

问题分析

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

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

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

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

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

代码

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

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
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
1
2
3
4
5
6
7
8
9
10
11
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


本站由 panoshu 使用 Stellar 1.29.1 主题创建。
本博客所有文章除特别声明外,均采用 CC BY-NC-SA 4.0 许可协议,转载请注明出处。

访客数: 人,总访问量: 次。