[已解决]数组求助，怎么用数组实现精确查找，具体问题在附件

mypicko

之前用的FIND实现的，还插了好多EXCEL 公式，一次算好多的，实在太慢。现在准备用数组来搞，不知道怎么用数组实现Find,和Findnext的功能。求大神帮助

最佳答案

月排行榜 / 总排行榜

dsmch

2016-5-12 14:48

1. Sub Macro1()
   
2. Dim arr, brr, d, d2, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary")
   
5. arr = Range("a1").CurrentRegion
   
6. brr = Range("d1").CurrentRegion
   
7. For i = 2 To UBound(arr)
   
8. d(arr(i, 2)) = d(arr(i, 2)) & "," & arr(i, 1)
   
9. Next
   
10. For i = 2 To UBound(brr)
    
11.     d2(brr(i, 1)) = d2(brr(i, 1)) + 1
    
12.     brr(i, 2) = Split(d(brr(i, 1)), ",")(d2(brr(i, 1)))
    
13. Next
    
14. Range("e1").Resize(UBound(brr)) = Application.Index(brr, 0, 2)
    
15. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, d2, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary")
   
5. arr = Range("a1").CurrentRegion
   
6. brr = Range("d1").CurrentRegion
   
7. For i = 2 To UBound(arr)
   
8. d(arr(i, 2)) = d(arr(i, 2)) & "," & arr(i, 1)
   
9. Next
   
10. For i = 2 To UBound(brr)
    
11.     d2(brr(i, 1)) = d2(brr(i, 1)) + 1
    
12.     brr(i, 2) = Split(d(brr(i, 1)), ",")(d2(brr(i, 1)))
    
13. Next
    
14. Range("e1").Resize(UBound(brr)) = Application.Index(brr, 0, 2)
    
15. End Sub

复制代码

baksy

附件

mypicko

baksy 发表于 2016-5-12 14:27
附件

谢谢，完美解决问题

mypicko

dsmch 发表于 2016-5-12 14:48

这个写的看起来清爽多了，谢谢！