[已解决]【求助】EXCEL 按照出现次数进行统计和排序

malteser · 发表于 2012-10-9 20:34

本帖最后由 malteser 于 2012-10-10 07:52 编辑

我公司要按照公司的客户资料进行统计，分别从各个直辖市/省份来了多少人。就像我的sheet里面的。  数据是每天不停更新的，所以我无法知道到哪一行截止

我希望能通过VBA实现：
1.  自动在统计那里，人数按照由多至少（就是各个省/直辖市在C列出现的次数）的顺序，进行排序，  比如
上海 7
江苏 5

等等（请假设中国有多少个省/直辖市我们是不知道的，因为我还要统计他们是哪个公司推荐过来的，推荐公司的总数和名字是我现在无法知道的）

2.  按照来自的省份、直辖市，在另外一张sheet重新排序，就是类似这样
北京
北京
北京
北京
北京
山东
山东                   以此类推，不知道我解释清楚没有，如果没有解释清楚，请和我说一下，我重新说

最佳答案

月排行榜 / 总排行榜

suye1010

2012-10-10 00:03

本帖最后由 suye1010 于 2012-10-10 00:40 编辑

Sub Test()
Dim arr0, Temparr, d, i%, j%, k%, m%, n%, Itm, arr, T1, T2, arr9(1 To 10000, 1 To 3), CT%
Set d = CreateObject("Scripting.Dictionary")
arr0 = Range("A1").CurrentRegion
'这里记录每个城市出现的人名和代号，方便后续继续处理各个城市的信息
For i = 2 To UBound(arr0)
If d.exists(arr0(i, 3)) Then
Temparr = d(arr0(i, 3))
ReDim Preserve Temparr(1 To 2, 1 To UBound(Temparr, 2) + 1)
Temparr(1, UBound(Temparr, 2)) = arr0(i, 1)
Temparr(2, UBound(Temparr, 2)) = arr0(i, 2)
d(arr0(i, 3)) = Temparr
Else
ReDim Temparr(1 To 2, 1 To 1)
Temparr(1, 1) = arr0(i, 1)
Temparr(2, 1) = arr0(i, 2)
d.Add arr0(i, 3), Temparr
End If
Erase Temparr
Next i
ReDim arr(1 To d.Count, 1 To 2)
'统计各个城市的人数
For Each Itm In d.keys
k = k + 1
arr(k, 1) = Itm
arr(k, 2) = UBound(d(Itm), 2)
Next
'对各个城市的人数进行排序
For m = 1 To UBound(arr) - 1
For n = m + 1 To UBound(arr)
If arr(m, 2) < arr(n, 2) Then
T1 = arr(m, 1)
T2 = arr(m, 2)
arr(m, 1) = arr(n, 1)
arr(m, 2) = arr(n, 2)
arr(n, 1) = T1
arr(n, 2) = T2
End If
Next n
Next m
Cells(2, 8).Resize(d.Count, 2) = arr
'以下对数据进行按城市名的重排
For j = 1 To UBound(arr)
For p = 1 To UBound(d(arr(j, 1)), 2)
CT = CT + 1
arr9(CT, 1) = CT
arr9(CT, 2) = arr(j, 1)
arr9(CT, 3) = d(arr(j, 1))(2, p)
Next p
Next j
Sheets(2).Cells(1, 1).Resize(10000, 3) = arr9
End Sub

复制代码

求助统计和排序.zip (19.23 KB, 下载次数: 5, 售价: 1 个金币)

suye1010 · 发表于 2012-10-10 00:03

这个最佳答案由 suye1010 给出，感谢 suye1010 的回答。

单击隐藏图章

本帖最后由 suye1010 于 2012-10-10 00:40 编辑

Sub Test()
Dim arr0, Temparr, d, i%, j%, k%, m%, n%, Itm, arr, T1, T2, arr9(1 To 10000, 1 To 3), CT%
Set d = CreateObject("Scripting.Dictionary")
arr0 = Range("A1").CurrentRegion
'这里记录每个城市出现的人名和代号，方便后续继续处理各个城市的信息
For i = 2 To UBound(arr0)
If d.exists(arr0(i, 3)) Then
Temparr = d(arr0(i, 3))
ReDim Preserve Temparr(1 To 2, 1 To UBound(Temparr, 2) + 1)
Temparr(1, UBound(Temparr, 2)) = arr0(i, 1)
Temparr(2, UBound(Temparr, 2)) = arr0(i, 2)
d(arr0(i, 3)) = Temparr
Else
ReDim Temparr(1 To 2, 1 To 1)
Temparr(1, 1) = arr0(i, 1)
Temparr(2, 1) = arr0(i, 2)
d.Add arr0(i, 3), Temparr
End If
Erase Temparr
Next i
ReDim arr(1 To d.Count, 1 To 2)
'统计各个城市的人数
For Each Itm In d.keys
k = k + 1
arr(k, 1) = Itm
arr(k, 2) = UBound(d(Itm), 2)
Next
'对各个城市的人数进行排序
For m = 1 To UBound(arr) - 1
For n = m + 1 To UBound(arr)
If arr(m, 2) < arr(n, 2) Then
T1 = arr(m, 1)
T2 = arr(m, 2)
arr(m, 1) = arr(n, 1)
arr(m, 2) = arr(n, 2)
arr(n, 1) = T1
arr(n, 2) = T2
End If
Next n
Next m
Cells(2, 8).Resize(d.Count, 2) = arr
'以下对数据进行按城市名的重排
For j = 1 To UBound(arr)
For p = 1 To UBound(d(arr(j, 1)), 2)
CT = CT + 1
arr9(CT, 1) = CT
arr9(CT, 2) = arr(j, 1)
arr9(CT, 3) = d(arr(j, 1))(2, p)
Next p
Next j
Sheets(2).Cells(1, 1).Resize(10000, 3) = arr9
End Sub

复制代码

求助统计和排序.zip (19.23 KB, 下载次数: 5, 售价: 1 个金币)

malteser · 发表于 2012-10-10 15:27

suye1010 发表于 2012-10-10 00:03

太谢谢你了！版主！！！

不过我能不能多问一句？就是重新排列的时候，我需要将地区原来对应的序列号一起放在新的sheet里面，而且本来在姓名那一栏都是有东西的，但是由于公司的保密政策，我就删除了。

所以如何将他们按照地区的顺序，整个一行那么重新排列过? 如果是一个新的MACRO那最好了，我不想将统计和重新排序放在一个macro里面一起运行！！

五体投地！！！！感谢！！！

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

[已解决]【求助】EXCEL 按照出现次数进行统计和排序

相关帖子