[已解决]请教各位论坛老师，写一段VBA查找的代码

yslvictor

各位老师你们好，通过各位的指导学会了不少的东西。
今请各位写个查找的代码。
查找范围：C10:C209;
D10,E10和F10是C210分出来的百、十和个位的字符(C210是3个字符的文本数字，值不定);
查找方法是从C209开始，往上查找出10个符合条件的数据，
例如：从C209开始往上查找百位等于D10的数据(D10=1),分别是C206、C199、C198、C183……，它们的下一行的数据C207、C200、C199、C184……的值分别是792、815、169、030……，放到D11往下排放。
同样的方法查找出十位等于E10的数据和个位等于F10的下一行数据。
（颜色是手动查找自行标的与代码查找无关。）
如图：

查找.rar (6.71 KB, 下载次数: 10)

2014-3-30 20:15 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-31 13:14

1. Sub Macro1()
   
2. Dim arr, brr(1 To 10, 1 To 3), w(1 To 3)
   
3. Dim i%, j&, s%
   
4. x = [c210]
   
5. arr = [c10:c210]
   
6. For i = 1 To Len(x)
   
7.     w(i) = Mid(x, i, 1)
   
8. Next
   
9. For i = 1 To 3
   
10.     s = 0
    
11.     For j = UBound(arr) - 1 To 1 Step -1
    
12.         If Mid(arr(j, 1), i, 1) = w(i) Then
    
13.             s = s + 1
    
14.             If s > 10 Then Exit For Else brr(s, i) = arr(j + 1, 1)
    
15.         End If
    
16.     Next
    
17. Next
    
18. [d11:f20].NumberFormatLocal = "000"
    
19. [d11:f20] = brr
    
20. End Sub
    

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr(1 To 10, 1 To 3), w(1 To 3)
   
3. Dim i%, j&, s%
   
4. x = [c210]
   
5. arr = [c10:c210]
   
6. For i = 1 To Len(x)
   
7.     w(i) = Mid(x, i, 1)
   
8. Next
   
9. For i = 1 To 3
   
10.     s = 0
    
11.     For j = UBound(arr) - 1 To 1 Step -1
    
12.         If Mid(arr(j, 1), i, 1) = w(i) Then
    
13.             s = s + 1
    
14.             If s > 10 Then Exit For Else brr(s, i) = arr(j + 1, 1)
    
15.         End If
    
16.     Next
    
17. Next
    
18. [d11:f20].NumberFormatLocal = "000"
    
19. [d11:f20] = brr
    
20. End Sub
    

复制代码

dsmch

………………

yslvictor

谢谢dsmch大师，正是我要的代码，我把"000"换成"@"就是理想的代码。