求助一个多条件统计的问题

凡尘158

图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)

2024-1-16 13:55 上传

点击文件名下载附件

ykcbf1100

测试了一下，2月份统计汇总也正常的。

凡尘158

ykcbf1100 发表于 2024-1-16 16:27
测试了一下，2月份统计汇总也正常的。

用图4的代码测试后，每个月的数据都能计算出来，但是会把其他列：比如工时、合计里面的计算公式清空只留下计算后的结果。

凡尘158

试了几种方法好像都有各种问题，除非在每个月的前面都加上姓名列就可以不出错了

准提部林

按月統計..重寫//..by.准提部林
Xl0000200.rar (328.18 KB, 下载次数: 20)

2024-1-18 14:12 上传

点击文件名下载附件

凡尘158

准提部林 发表于 2024-1-18 14:13
按月統計..重寫//..by.准提部林

这个方法很不错
又涨知识了
谢谢大佬！

dragonthree

准提部林 发表于 2024-1-18 14:13
按月統計..重寫//..by.准提部林

看别人的代码总能学到一些知识，偷学了一句：ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text