宏代码：能否直接判断某数据在某列数据中的行数

本帖最后由 lijian8003 于 2014-11-4 23:31 编辑

问题一：
B C D ...各列从第5行开始是0-99的乱序排列，
若B列从第5行开始某单元格的数据=B1，则提取该单元格对应的A列同行数据，写入B2单元格；
若C列从第5行开始某单元格的数据=C1，则提取该单元格对应的A列同行数据，写入C2单元格；
若D1为空，则D2为空；
……
例如：
B列中，B6=B1,则提取A6的数据2写入B2；
C列中，C7=C1,则提取A7的数据3写入C2；
D列中，D1为空，则D2为空
……

问题二：
上例的逆反运用。例如：
1、先看第3行
B3 C3为空，不取数据；
D3=6，则取A列数据为6的单元格(即A10=6)对应的D列同行数据(即D10=53)，写入工作表“数据2”的B1(即B1=53)；
E3 F3为空，不取数据；
G3=7，则取A列数据为7的单元格(即A11=7)对应的G列同行数据(即G11=79)，写入工作表“数据2”的C1(即C1=79)；
H3 I3为空，不取数据；
J3=8，则取A列数据为8的单元格(即A12=8)对应的J列同行数据(即J12=17)，写入工作表“数据2”的D1(即D1=17)
……
2、再看第4行
B4 C4 D4为空，不取数据；
E4=12，则取A列数据为12的单元格(即A16=12)对应的E列同行数据(即E16=61)，写入工作表“数据2”的B2(即B2=61)；
F4 G4为空，不取数据；
H4=13，则取A列数据为13的单元格(即A17=13)对应的H列同行数据(即H17=46)，写入工作表“数据2”的C2(即C2=46)；
I4 J4为空，不取数据；
K4=14，则取A列数据为14的单元格(即A18=14)对应的K列同行数据(即K18=50)，写入工作表“数据2”的D2(即D2=50)
……

1. Sub 问题1()
   
2. Application.ScreenUpdating = False
   
3. For j = 2 To 11
   
4. For i = 5 To 104
   
5. If Cells(i, j) = Cells(1, j) Then Cells(2, j) = Cells(i, 1)
   
6. If Cells(1, j) = '' Then Cells(2, j) = ''
   
7. Next
   
8. Next
   
9. Application.ScreenUpdating = True
   
10. End Sub

1. Sub 问题2()
   
2. Application.ScreenUpdating = False
   
3. For j = 2 To 11
   
4. For i = 5 To 104
   
5. If Cells(3, j) <> '' And Cells(i, 1) = Cells(3, j) Then
   
6. Sheet2.Cells(1, 2 + n) = Cells(i, j)
   
7. n = n + 1
   
8. End If
   
9. If Cells(4, j) <> '' And Cells(i, 1) = Cells(4, j) Then
   
10. Sheet2.Cells(2, 2 + k) = Cells(i, j)
    
11. k = k + 1
    
12. End If
    
13. Next
    
14. Next
    
15. Application.ScreenUpdating = True
    
16. End Sub

上述代码实际运行中，速度较慢。

我寻思：宏代码能否撇开与A5-A104的数据互转，直接判断某数据在某列数据中的行数？

比如 B列：
预先设定B5为第1行，B6为第2行......B104为第100行
B1=95，查找B列中95的数据在第2行，则在B2写入2；
C列、E列、F列、H列、I列......同理。

比如 D列：
预先设定D5为第1行，D6为第2行......D104为第100行
D3=6，查找D列中第6行的数据为53，则提取53，并在工作表“数据2”的B1写入53；
D列、E列、G列、H列......同理。

1. Sub 问题1()
   
2. Application.ScreenUpdating = False
   
3. arr = [a5:xfa104]
   
4. [a2:xfa2] = ''
   
5. brr = [a1:xfa2]
   
6. For j = 2 To UBound(arr, 2)
   
7. For i = 1 To UBound(arr)
   
8. If arr(i, j) = brr(1, j) Then brr(2, j) = arr(i, 1)
   
9. If brr(1, j) = '' Then brr(2, j) = ''
   
10. Next
    
11. Next
    
12. [a1].Resize(UBound(brr), UBound(brr, 2)) = brr
    
13. Application.ScreenUpdating = True
    
14. End Sub
    
15. 
    
16. Sub 问题2()
    
17. Application.ScreenUpdating = False
    
18. arr = [a5:xfa104]
    
19. a = [a3:xfa3]
    
20. b = [a4:xfa4]
    
21. For j = 2 To UBound(arr, 2)
    
22. For i = 1 To UBound(arr)
    
23. If a(1, j) <> '' And arr(i, 1) = a(1, j) Then
    
24. Sheet2.Cells(1, 2 + n) = arr(i, j)
    
25. n = n + 1
    
26. End If
    
27. If b(1, j) <> '' And arr(i, 1) = b(1, j) Then
    
28. Sheet2.Cells(2, 2 + k) = arr(i, j)
    
29. k = k + 1
    
30. End If
    
31. Next
    
32. Next
    
33. Application.ScreenUpdating = True
    
34. End Sub