[已解决]求助个vba

oiufg

Book2.xls4.rar (2.78 KB, 下载次数: 9)

2013-3-8 11:25 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

liuguansky

2013-3-8 11:46

1. 
   
2. 
   
3. Sub ye()
   
4.     Dim Ar(1), D As New Dictionary, I&
   
5. 
   
6.     Ar(0) = Range([k2], [k2].End(4)).Value
   
7.     Ar(1) = Range([i2], [i2].End(4)).Value
   
8. 
   
9.     For I = 1 To UBound(Ar(0))
   
10.         D(Ar(0)(I, 1)) = D(Ar(0)(I, 1)) + 1
    
11.     Next I
    
12. 
    
13.     For I = 1 To UBound(Ar(1))
    
14.         If D.Exists(Ar(1)(I, 1)) Then
    
15.             D(Ar(1)(I, 1)) = D(Ar(1)(I, 1)) - 1
    
16.             If D(Ar(1)(I, 1)) < 3 Then D.Remove Ar(1)(I, 1)
    
17.         End If
    
18.     Next I
    
19. 
    
20.     If D.Count > 0 Then [a1].Resize(D.Count) = Application.Transpose(D.Keys)
    
21. End Sub
    
22. 
    

复制代码

Book2.xls4.rar (10 KB, 下载次数: 3)

2013-3-8 11:44 上传

点击文件名下载附件

跳转到最佳答案楼层

那么的帅

296499-VBA-字典-条件提取.rar (10.92 KB, 下载次数: 5)

2013-3-8 11:45 上传

点击文件名下载附件

liuguansky

1. 
   
2. 
   
3. Sub ye()
   
4.     Dim Ar(1), D As New Dictionary, I&
   
5. 
   
6.     Ar(0) = Range([k2], [k2].End(4)).Value
   
7.     Ar(1) = Range([i2], [i2].End(4)).Value
   
8. 
   
9.     For I = 1 To UBound(Ar(0))
   
10.         D(Ar(0)(I, 1)) = D(Ar(0)(I, 1)) + 1
    
11.     Next I
    
12. 
    
13.     For I = 1 To UBound(Ar(1))
    
14.         If D.Exists(Ar(1)(I, 1)) Then
    
15.             D(Ar(1)(I, 1)) = D(Ar(1)(I, 1)) - 1
    
16.             If D(Ar(1)(I, 1)) < 3 Then D.Remove Ar(1)(I, 1)
    
17.         End If
    
18.     Next I
    
19. 
    
20.     If D.Count > 0 Then [a1].Resize(D.Count) = Application.Transpose(D.Keys)
    
21. End Sub
    
22. 
    

复制代码

Book2.xls4.rar (10 KB, 下载次数: 3)

2013-3-8 11:44 上传

点击文件名下载附件