[已解决]求个简单的vba

uuw5

book1.rar (148.83 KB, 下载次数: 15)

2013-3-23 21:33 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-3-23 21:44

1. Sub 统计()
   
2.     Dim arr, result(1 To 65536)
   
3.     Dim lCount&
   
4.     Dim i%
   
5.     Dim a
   
6.     Dim dic As Object
   
7.     Set dic = CreateObject("scripting.dictionary")
   
8. 
   
9.     i = [e1]
   
10.     arr = Range("h3").CurrentRegion
    
11.     For Each a In arr
    
12.         dic(a) = dic(a) + 1
    
13.     Next
    
14.     For Each a In dic.keys
    
15.         If dic(a) = i Then
    
16.             lCount = lCount + 1
    
17.             result(lCount) = "'" & a
    
18.         End If
    
19.     Next
    
20. 
    
21.     If lCount > 0 Then
    
22.         Range("a1").Resize(lCount) = WorksheetFunction.Transpose(result)
    
23.     Else
    
24.         MsgBox "无符合要求的数据"
    
25.     End If
    
26. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Sub 统计()
   
2.     Dim arr, result(1 To 65536)
   
3.     Dim lCount&
   
4.     Dim i%
   
5.     Dim a
   
6.     Dim dic As Object
   
7.     Set dic = CreateObject("scripting.dictionary")
   
8. 
   
9.     i = [e1]
   
10.     arr = Range("h3").CurrentRegion
    
11.     For Each a In arr
    
12.         dic(a) = dic(a) + 1
    
13.     Next
    
14.     For Each a In dic.keys
    
15.         If dic(a) = i Then
    
16.             lCount = lCount + 1
    
17.             result(lCount) = "'" & a
    
18.         End If
    
19.     Next
    
20. 
    
21.     If lCount > 0 Then
    
22.         Range("a1").Resize(lCount) = WorksheetFunction.Transpose(result)
    
23.     Else
    
24.         MsgBox "无符合要求的数据"
    
25.     End If
    
26. End Sub

复制代码

hwc2ycy

没有重复次数是8的数据。

1032446692

比较简单  你也简单的看一下吧

hwc2ycy

又是意思表达不够清楚了，两种结果。

1032446692

我的是错的 可是我没查出错啊

1032446692

找出H3:O1000里重复个数是E1的数放B列


原来不是我错了  是我太相信他了  只按题目  没去看到底有多少行！！！！
这真是简单啊