[已解决]求vba

oiufg

book1.rar (211.12 KB, 下载次数: 17)

2015-1-16 10:33 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2015-1-16 10:59

1. Sub Macro1()
   
2. Dim arr, d, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("g3:g" & Range("g65536").End(xlUp).Row)
   
5. For i = 1 To UBound(arr)
   
6.     d(arr(i, 1)) = d(arr(i, 1)) + 1
   
7. Next
   
8. a = d.Keys: b = d.Items
   
9. x = Application.Max(b)
   
10. For i = 0 To d.Count - 1
    
11.     If b(i) = x Then p = p & "," & a(i)
    
12. Next
    
13. [b2] = Mid(p, 2)
    
14. [d1] = x & "个"
    
15. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, d, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("g3:g" & Range("g65536").End(xlUp).Row)
   
5. For i = 1 To UBound(arr)
   
6.     d(arr(i, 1)) = d(arr(i, 1)) + 1
   
7. Next
   
8. a = d.Keys: b = d.Items
   
9. x = Application.Max(b)
   
10. For i = 0 To d.Count - 1
    
11.     If b(i) = x Then p = p & "," & a(i)
    
12. Next
    
13. [b2] = Mid(p, 2)
    
14. [d1] = x & "个"
    
15. End Sub

复制代码