更进一步的汇总不会了，请大家指点下

wuaijie

物品按照周汇总，代码已经写好了。

请大家看文件，数据已经实现了按周和物品种类汇总，和分类汇总相似。

现在想实现的是，
1、物品是按照周汇总。
2、个别，如大米、小米要实现的在每月第一周汇总。
3、蔬菜、猪肉分周汇总。
4，要想实现效果如下


如何修改代码呢？
编了几次不成功，求助各位老师

wuaijie

如果源代码不合适，重写也行

3190496160

Sub 汇总()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("sheet1")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:c" & r)
    ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            If IsDate(ar(i, 1)) Then
                zc = Application.WeekNum((ar(i, 1)), 2)
                zd = zc & "|" & Trim(ar(i, 2))
                t = d(zd)
                If t = "" Then
                    k = k + 1
                    d(zd) = k
                    t = k
                    br(k, 1) = zc
                    br(k, 2) = ar(i, 2)
                End If
                br(t, 3) = br(t, 3) + ar(i, 3)
            End If
        End If
    Next i
    .[f1].CurrentRegion.Offset(1) = Empty
    .[f2].Resize(k, UBound(br, 2)) = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

按两种方式汇总（周汇总 物品分类汇总）.rar (23.17 KB, 下载次数: 13)

2023-4-20 08:46 上传

点击文件名下载附件

三分醉，七分醒

你的“一周”是6天还是7天，1月7算第1周科学家是第2周

全党

参与一下。。。。。。。。

wuaijie

全党 发表于 2023-4-20 11:00
参与一下。。。。。。。。

好的，下载学习中，加油向老师们看齐

wuaijie

3190496160 发表于 2023-4-20 08:45
Sub 汇总()
Application.ScreenUpdating = False
Dim ar As Variant

谢谢老师，下载学习中。

wuaijie

三分醉，七分醒 发表于 2023-4-20 09:57
你的“一周”是6天还是7天，1月7算第1周科学家是第2周

一周就是法定的一个星期，按照中国传统，周一是一周开始