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

wuaijie

3190496160 发表于 2023-4-20 08:45

好像不对
得到的是这种效果
1月1日        猪肉        597.172
1月1日        白菜        519.973
1月1日        小米        290.559
1月1日        大米        256.477
1月2日        大米        885.684
2        猪肉        623.23
2        白菜        597.239
2        小米        310.281
3        大米        507.793
3        猪肉        570.453
3        白菜        296.715
3        小米        286.691
4        白菜        421.547
4        大米        755.274
4        猪肉        150.961
4        小米        227.406
5        猪肉        269.504
5        白菜        255.145

而不是题目中想要的效果

wuaijie

没有解决，请大家接力看看

wuaijie

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

不行哦，和我原来写的效果一样，没达到想要的效果，请看看第一楼的效果图片

wuaijie

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

老师，你可能没明白我的意思，我是要实现把大米和小米第一周就汇总了整月的，其他周就只汇总剩下的

wuaijie

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

老师，你可能没明白我的意思，我是要实现把大米和小米第一周就汇总了整月的，其他周就只汇总剩下的

三分醉，七分醒

路过一下，这是否满足你的要求

chxw68

详见附件。

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
                If Trim(ar(i, 2)) = "大米" Or Trim(ar(i, 2)) = "小米" Then
                    zd = Trim(ar(i, 2))
                    t = d(zd)
                    If t = "" Then
                        k = k + 1
                        d(zd) = k
                        t = k
                        br(k, 1) = 1
                        br(k, 2) = ar(i, 2)
                    End If
                    br(t, 3) = br(t, 3) + ar(i, 3)
                Else
                    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
        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

猜呢，
按两种方式汇总（周汇总 物品分类汇总22）.rar (23.05 KB, 下载次数: 6)

2023-4-21 14:23 上传

点击文件名下载附件