[已解决]用函数或VBA解决去重计数的问题

489330017

各位大神，帮帮忙啊，急用！

最佳答案

月排行榜 / 总排行榜

grf1973

2015-9-30 11:26

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     For i = 2 To UBound(arr)
   
6.         x = arr(i, 1) & arr(i, 2)
   
7.         If Not d1.exists(x) Then
   
8.             d1(x) = ""
   
9.             d(arr(i, 1)) = d(arr(i, 1)) + 1
   
10.         End If
    
11.     Next
    
12.     [d2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
13. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     For i = 2 To UBound(arr)
   
6.         x = arr(i, 1) & arr(i, 2)
   
7.         If Not d1.exists(x) Then
   
8.             d1(x) = ""
   
9.             d(arr(i, 1)) = d(arr(i, 1)) + 1
   
10.         End If
    
11.     Next
    
12.     [d2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
13. End Sub

复制代码

grf1973

搞了每天统计的表。在此基础上可以轻松搞定每月、每周统计。

489330017

grf1973 发表于 2015-9-30 11:26

好的，谢谢！非常好！

tanlylele

学习了，正需要