[已解决]如何使用VBA按条件合并两表格内容。。急。。求救。

dcybt

就是想使用VBA实现比较两表格中的规格。当规格匹配的时候把表格2的对应整行内容复制到相对就的规格中。因为数量很大。如果使用公式方法的话可能有点麻烦。。
1.rar (7.02 KB, 下载次数: 12)

2013-2-17 23:37 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

cbg2008

2013-2-18 00:01

1. Sub Data_Analysis()
   
2. On Error Resume Next
   
3. Dim Arr_Output, Arr_Input, i&, j&, iRow&
   
4. Dim D As Object
   
5. Application.ScreenUpdating = False
   
6. Arr_Input = Sheets("2表").UsedRange.Value
   
7. Set D = CreateObject("Scripting.Dictionary")
   
8. D.CompareMode = vbTextCompare
   
9. For i = 2 To UBound(Arr_Input)
   
10. D(Arr_Input(i, 2)) = i
    
11. Next
    
12. With Sheets("1表")
    
13. Arr_Output = .UsedRange
    
14. For i = 2 To UBound(Arr_Output)
    
15. iRow = D(Arr_Output(i, 2))
    
16. For j = 7 To 13
    
17. Arr_Output(i, j) = Arr_Input(iRow, j - 4)
    
18. Next j
    
19. Next i
    
20. .Range("A1").Resize(UBound(Arr_Output), UBound(Arr_Output, 2)) = Arr_Output
    
21. End With
    
22. Application.ScreenUpdating = True
    
23. MsgBox "已填写完毕！"
    
24. End Sub
    

复制代码

11.rar (13.79 KB, 下载次数: 22)

2013-2-18 00:01 上传

点击文件名下载附件

跳转到最佳答案楼层

cbg2008

1. Sub Data_Analysis()
   
2. On Error Resume Next
   
3. Dim Arr_Output, Arr_Input, i&, j&, iRow&
   
4. Dim D As Object
   
5. Application.ScreenUpdating = False
   
6. Arr_Input = Sheets("2表").UsedRange.Value
   
7. Set D = CreateObject("Scripting.Dictionary")
   
8. D.CompareMode = vbTextCompare
   
9. For i = 2 To UBound(Arr_Input)
   
10. D(Arr_Input(i, 2)) = i
    
11. Next
    
12. With Sheets("1表")
    
13. Arr_Output = .UsedRange
    
14. For i = 2 To UBound(Arr_Output)
    
15. iRow = D(Arr_Output(i, 2))
    
16. For j = 7 To 13
    
17. Arr_Output(i, j) = Arr_Input(iRow, j - 4)
    
18. Next j
    
19. Next i
    
20. .Range("A1").Resize(UBound(Arr_Output), UBound(Arr_Output, 2)) = Arr_Output
    
21. End With
    
22. Application.ScreenUpdating = True
    
23. MsgBox "已填写完毕！"
    
24. End Sub
    

复制代码

11.rar (13.79 KB, 下载次数: 22)

2013-2-18 00:01 上传

点击文件名下载附件