[已解决]工作表合并的问题

lh442246

见附表。 工作簿1.zip (9.49 KB, 下载次数: 11)

2014-5-6 15:09 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-5-6 15:39

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, crr, d, i&, j%, k%, s&, n%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = [a1:j1]
   
5. ReDim brr(1 To 60000, 1 To UBound(arr, 2))
   
6. For j = 1 To UBound(arr, 2)
   
7.     d(arr(1, j)) = j
   
8. Next
   
9. For j = 1 To 3
   
10.     crr = Sheets(j).Range("a1").CurrentRegion
    
11.     For i = 2 To UBound(crr)
    
12.         s = s + 1
    
13.         For k = 1 To UBound(crr, 2)
    
14.             If d.exists(crr(1, k)) Then
    
15.                 n = d(crr(1, k))
    
16.                 brr(s, n) = crr(i, k)
    
17.             End If
    
18.         Next
    
19.     Next
    
20. Next
    
21. Range("a2").Resize(s, UBound(brr, 2)) = brr
    
22. End Sub
    

复制代码

dsmch

………………

lh442246

dsmch 发表于 2014-5-6 15:39
………………

很好用，谢谢了。