按条件分类汇总指定项的数据

longlong2020

因为数据较多(10W+行数据)，用其它方式都不太适合，因此向大家求助。希望能通过VBA解决。谢谢大家！
sheet1和sheet2是我人工用来筛选统计用的，汇总1，汇总2是想要用vba来实现的。具体的说明已添加批注。
初始压缩包是图示例。测试数据是10W+脱敏数据

hfwufanhf2006

longlong2020 发表于 2020-6-11 16:12
谢谢，但是还是有问题

2个，3个，4,5。。。都有才正确

我反复看了，感觉统计没问题，是你的“汇总1”这个表我看不懂；
这个表里你保留了大量的编号，我以为你只是想查询这些指定的编号的统计结果，其他编号的统计数据都被舍弃。但看你的意思是要所有编号的统计结果，那么你这个表就不要写这么多特定的编号在里面，而且还有对应的日期更是让人迷惑；
我也只是猜测，拿不准你的意思；

如果是全部的编号统计，总的记录数有90455条，其中大于1 的记录有9695条，大多数只是2-4个，超过4的只有下面的23条：

202005220001	39
202005240001	9
202005240002	5
202005240003	11
202005270003	11
1111	6
0529001	6
202006010002	8
202006010004	11
202006010001	15
202006020004	5
202006020006	10
0603001	9
0603008	5
0604001	7
202006040001	20
0605001	8
202006050002	6
202006050003	9
202006060001	8
202006060004	47
202006070001	6
202006080001	7

这个结果我也不能肯定，我只是从纯统计的角度看似乎是正确的。你提供的表格式样容易产生歧义；
如果你觉得这个数据也不对，需要明确指出到底哪个不对，我才好针对性去检查；

要得到这个结果，把最后的输出代码修改下就行：
把：
For i = 2 To Cells(Rows.Count, 2).End(3).Row
    s = Cells(i, 2)
    If zd.exists(s) Then
       Cells(i, 3) = zd(s)(2)
    Else
       Cells(i, 3) = ""
    End If
Next i

改成：
arr2 = zd.keys
For i = 0 To UBound(arr2)
    Cells(i + 2, 5) = arr2(i)                       '输出放在e\f列，你原来的内容仍然还在
    Cells(i + 2, 6) = zd(arr2(i))(2)
Next i

hfwufanhf2006

1、数据透视一下子就弄好了，没必要用代码；
     如果你只是想要指定编号的结果，也可以以透视表为基础，在透视表中用vlookup去查找；
2、你强调说有10万多数据，如果一定要代码，这个数据量的效率是很重要的，所以上传文件要保留尽可能多的数据才能测试效率。你现在上传的文件才1000多行，是看不效率来的，任何方法估计都可以。有可能测试的效率飞快，但实际拿回去却慢的要死，这一点提问时尤其要注意；

longlong2020

hfwufanhf2006 发表于 2020-6-11 11:07
1、数据透视一下子就弄好了，没必要用代码；
     如果你只是想要指定编号的结果，也可以以透视表为基础， ...

已上传10W+脱敏数据

hfwufanhf2006

longlong2020 发表于 2020-6-11 11:58
已上传10W+脱敏数据

字典代码（在"汇总1"执行）：

Application.ScreenUpdating = False
Dim arr
arr = Worksheets("发货数据").Range("a2:n" & Worksheets("发货数据").Cells(Rows.Count, 1).End(3).Row)
Dim zd
Set zd = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
    zd(arr(i, 6)) = zd(arr(i, 6)) + 1
Next i
For i = 2 To Cells(Rows.Count, 2).End(3).Row
    s = Cells(i, 2)
    If zd(s) Then
       Cells(i, 3) = zd(s)
    Else
       Cells(i, 3) = ""
    End If
Next i
Application.ScreenUpdating = True

longlong2020

hfwufanhf2006 发表于 2020-6-11 12:33
字典代码（在"汇总1"执行）：

Application.ScreenUpdating = False

相同品名的未做处理，正确的应该是1才对，所以还得麻烦您看看

hfwufanhf2006

longlong2020 发表于 2020-6-11 13:52
相同品名的未做处理，正确的应该是1才对，所以还得麻烦您看看

没看懂：
以“编码”查询 以及 以“编码+品名”查询是两个不同的查询，既然要求按照“编码+品名”来分类，但在“汇总1”中却只有“编码”，没有“品名”，如何来区分它们？，比如：
  编码                      品名
668737657716809    TQMZW01
668737657716809    TQMZW02

668737657716809    TQMZW01
按照编码分类，是3条记录，按照 编码+品名 分类，分别是1和和2个：
668737657716809：3
668737657716809+TQMZW01：2
668737657716809+TQMZW02：1

再回到汇总1：


668737657716809：应该读取上面那个结果？

longlong2020

hfwufanhf2006 发表于 2020-6-11 14:36
没看懂：
以“编码”查询 以及 以“编码+品名”查询是两个不同的查询，既然要求按照“编码+品名”来分类 ...

抱歉，是我的原因。我把初始数据的示例删了。我的图是前面测试数据的截图，您说我的数据不全以后我就去掉了初始的压缩包。
668737657716809 是单号，品名个数是按商品编码来区分的，比如（测试数据初始）里面“668737657716809单号”里面含有两行明细，但是两行明细包含的商品编码都一样，所以品名个数应该是1，
但是（测试数据初始）里面“668737657716792”里面含有两行明细，但是两行明细包含的商品编码不一样，所以品名个数应该是2.

其实就是您说的，按”编码+品名”来处理
这样说，不知道是不是说明白了。

hfwufanhf2006

longlong2020 发表于 2020-6-11 14:58
抱歉，是我的原因。我把初始数据的示例删了。我的图是前面测试数据的截图，您说我的数据不全以后我就去掉 ...

你测试下这个代码看看，不知道是不是你的要求：

Application.ScreenUpdating = False
Dim arr
Dim arr1(1 To 2)
Dim arr2
arr = Worksheets("发货数据").Range("a2:n" & Worksheets("发货数据").Cells(Rows.Count, 1).End(3).Row)
Dim zd
Set zd = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
    If Not zd.exists(arr(i, 6)) Then
       arr1(1) = arr(i, 11)
       arr1(2) = 1
       zd(arr(i, 6)) = arr1
    Else
       arr2 = zd(arr(i, 6))
       If InStr(arr2(1), arr(i, 11)) = 0 Then
          arr2(1) = arr2(1) & "/" & arr(i, 11)
          arr2(2) = arr2(2) + 1
          zd(arr(i, 6)) = arr2
       End If
    End If
Next i
For i = 2 To Cells(Rows.Count, 2).End(3).Row
    s = Cells(i, 2)
    If zd.exists(s) Then
       Cells(i, 3) = zd(s)(2)
    Else
       Cells(i, 3) = ""
    End If
Next i
Application.ScreenUpdating = True


按照这个代码，最后只有这么几个是大于1的，我有点信心不足：

668737657000432	2
668737849555314	2
668737849555326	2
668737849334292	2
668737849334309	2
668737849334315	2
668737850130766	2
668737849334322	2
668737849334334	2
668737849580796	2
202005220001	39

longlong2020

hfwufanhf2006 发表于 2020-6-11 15:04
你测试下这个代码看看，不知道是不是你的要求：

Application.ScreenUpdating = False

谢谢，但是还是有问题

2个，3个，4,5。。。都有才正确