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

wuaijie · 发表于 2023-4-20 20:01

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 · 发表于 2023-4-20 20:05

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

wuaijie · 发表于 2023-4-20 20:06

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

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

wuaijie · 发表于 2023-4-20 20:24

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

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

wuaijie · 发表于 2023-4-20 20:25

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

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

三分醉，七分醒 · 发表于 2023-4-20 20:48

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

chxw68 · 发表于 2023-4-20 20:54

详见附件。

3190496160 · 发表于 2023-4-21 14:22

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 · 发表于 2023-4-21 14:23

猜呢，

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

		自动登录	找回密码
密码			免费注册

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

评分