[已解决]如何用宏代码，提取特定单元格的数据

lijian8003

工作表对比1、工作表对比2中有若干数据一一对应，

1、在工作表对比1中，若C1-K1单元格有数据等于工作表对比2中B2的数据，则提取该单元格对应的工作表对比2中的下一个单元格数据，依次写入工作表对比3的A1 B1 C1...【比如  工作表对比2中B2=44，工作表对比1中D1=44 F1=44，则提取工作表对比1中D2 F2的数据，写入工作表对比3的A1 B1 】

2、在工作表对比1中，若C2-K2单元格有数据等于工作表对比2中B3的数据，则提取该单元格对应的工作表对比2中的下一个单元格数据，依次写入工作表对比3的A2 B2 C2...【比如  工作表对比2中B3=40，工作表对比1中E2=40 K2=40，则提取工作表对比1中E3 K3的数据，写入工作表对比3的A2 B2 】

若没有数据相同，则在工作表对比3相应的的A B C...单元格写入空

上述举例只有几行，实际运用中有若干行

最佳答案

月排行榜 / 总排行榜

dsmch

2014-10-20 18:15

1. Sub Macro1()
   
2. Dim arr, brr, crr, i&, j%, s%, n%
   
3. arr = Sheet1.Range("a1").CurrentRegion
   
4. brr = Sheet2.Range("a1").CurrentRegion
   
5. ReDim crr(1 To UBound(arr) - 1, 1 To UBound(arr, 2) - 2)
   
6. For i = 1 To UBound(arr) - 1
   
7.     x = brr(i + 1, 2): s = 0
   
8.     For j = 3 To UBound(arr, 2)
   
9.         If arr(i, j) = x Then s = s + 1: crr(i, s) = arr(i + 1, j)
   
10.     Next
    
11.         If s > n Then n = s
    
12. Next
    
13. Sheet3.Activate
    
14. [a:i].ClearContents
    
15. [a:i].NumberFormatLocal = "@"
    
16. [a1].Resize(UBound(crr), n) = crr
    
17. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, crr, i&, j%, s%, n%
   
3. arr = Sheet1.Range("a1").CurrentRegion
   
4. brr = Sheet2.Range("a1").CurrentRegion
   
5. ReDim crr(1 To UBound(arr) - 1, 1 To UBound(arr, 2) - 2)
   
6. For i = 1 To UBound(arr) - 1
   
7.     x = brr(i + 1, 2): s = 0
   
8.     For j = 3 To UBound(arr, 2)
   
9.         If arr(i, j) = x Then s = s + 1: crr(i, s) = arr(i + 1, j)
   
10.     Next
    
11.         If s > n Then n = s
    
12. Next
    
13. Sheet3.Activate
    
14. [a:i].ClearContents
    
15. [a:i].NumberFormatLocal = "@"
    
16. [a1].Resize(UBound(crr), n) = crr
    
17. End Sub

复制代码

dsmch

………………

lijian8003

dsmch 发表于 2014-10-20 18:15

您的代码完美解决问题。实际运用中有些变化，试图修改代码，未果。恳望继续得到您的帮助。
具体变化如下：
工作表“对比1”、工作表“对比2”中有若干数据一一对应，
1、在工作表“对比1”中，若C1-K1单元格有数据等于工作表“对比2”中B1数据【原先是：B2】，则提取该单元格对应的工作表“对比2”中的单元格数据【原先是：下一个单元格数据】，依次写入工作表对比3的A1 B1 C1...
2、在工作表“对比1”中，若C2-K2单元格有数据等于工作表“对比2”中B2的数据【原先是：B3】，则提取该单元格对应的工作表“对比2”中的单元格数据【原先是：下一个单元格数据】，依次写入工作表对比3的A2 B2 C2...
若没有数据相同，则在工作表对比3相应的的A B C...单元格写入空
上述举例只有几行，实际运用中有若干行

lijian8003

dsmch 发表于 2014-10-20 18:17
………………

模拟见附件。

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim arr, brr, crr, i&, j%, s%, n%
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. brr = Sheet2.Range("a1").CurrentRegion
   
6. ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2) - 2)
   
7. For i = 1 To UBound(arr)
   
8.     x = brr(i, 2): s = 0
   
9.     For j = 3 To UBound(arr, 2)
   
10.         If arr(i, j) = x Then s = s + 1: crr(i, s) = brr(i, j)
    
11.     Next
    
12.     If s > n Then n = s
    
13. Next
    
14. Sheet3.Activate
    
15. [a:i].ClearContents
    
16. [a:i].NumberFormatLocal = "@"
    
17. With [a1].Resize(UBound(crr), n)
    
18.     .Value = crr
    
19.     .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
20. End With
    
21. End Sub

复制代码