|
|
本帖最后由 凡尘158 于 2024-1-16 14:12 编辑
图1是统计表格的框架，左边的姓名，上面是每个月相同的统计项目
一月的通过代码可以正常统计
Sub 求和1月()
Dim arr, brr
Dim d As Object
Dim k%, i%, m%, str$, str1$
arr = Sheets("物件统计2301").Range("a1:A3001").CurrentRegion
brr = Sheets("作图2").Range("b3:G60").CurrentRegion
Set d = CreateObject("scripting.dictionary")
For k = 2 To UBound(arr)
str = arr(k, 1) & arr(k, 7)
If Not d.exists(str) Then
d(str) = arr(k, 19)
Else
d(str) = d(str) + arr(k, 19)
End If
Next k
For i = 2 To 58
For m = 2 To 6
str1 = brr(i, 1) & brr(1, m)
brr(i, m) = d(str1)
Next m
Next i
Sheets("作图2").Range("b3:G60").Value = brr
MsgBox "计算完成"
End Sub
但是2月的统计就有问题了
Sub 求和2月()
Dim arr, brr
Dim d As Object
Dim k%, i%, m%, str$, str1$
arr = Sheets("物件统计2302").Range("a1:A3001").CurrentRegion
brr = Sheets("作图2").Range("L3:P60").CurrentRegion
Set d = CreateObject("scripting.dictionary")
For k = 2 To UBound(arr)
str = arr(k, 1) & arr(k, 7)
If Not d.exists(str) Then
d(str) = arr(k, 19)
Else
d(str) = d(str) + arr(k, 19)
End If
Next k
For i = 2 To 58
For m = 1 To 5
str1 = brr(i, 1) & brr(1, m)
brr(i, m) = d(str1)
Next m
Next i
Sheets("作图2").Range("L3:P60").Value = brr
MsgBox "计算完成"
End Sub
直接把2月的上面统计项目栏改了，下面的数据也就不能统计出来
把代码中的 For m = 1 To 5 改成 For m = 2 To 6后，2月第一列直接变成姓名列了
代码改成图4的样子，每个月都能计算，但是会把其他列（合计，工时等）里面的公式清空，只留下计算结果
另外，统计表格是第三行开始，但是如果第二行有任何数据，都会统计报错，直接把下面表格的项目清空了。见图5
2023年度统计汇总.rar
(694.76 KB, 下载次数: 17)
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-1-16 14:05
楼主
