[已解决]vba程序急需续！！！！！！！！！

3477

vba程序急需续！！！！！！！！！

最佳答案

月排行榜 / 总排行榜

zjcat35

2012-8-16 20:27

1. Sub a()
   
2.     Dim d As Object
   
3.     Dim i%, j%, arr, brr()
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = Sheet3.Range("a1").CurrentRegion
   
6.     For i = 2 To UBound(arr)
   
7.         d(arr(i, 1)) = arr(i, 2)
   
8.     Next i
   
9.     Erase arr
   
10.     arr = Sheet2.Range("a2").Resize(Cells(Rows.Count, 1).End(3).Row - 1)
    
11.     ReDim brr(1 To UBound(arr), 1 To 1)
    
12.     For j = 1 To UBound(arr)
    
13.         brr(j, 1) = d(arr(j, 1))
    
14.     Next j
    
15.     Range("b2").Resize(UBound(brr)) = brr
    
16. End Sub

复制代码

跳转到最佳答案楼层

hoogle

不明白什么意思，是要返回第二个工作表样式的结果吗？

3477

hoogle 发表于 2012-8-16 20:23
不明白什么意思，是要返回第二个工作表样式的结果吗？

第一个表的b列为结果

zjcat35

1. Sub a()
   
2.     Dim d As Object
   
3.     Dim i%, j%, arr, brr()
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = Sheet3.Range("a1").CurrentRegion
   
6.     For i = 2 To UBound(arr)
   
7.         d(arr(i, 1)) = arr(i, 2)
   
8.     Next i
   
9.     Erase arr
   
10.     arr = Sheet2.Range("a2").Resize(Cells(Rows.Count, 1).End(3).Row - 1)
    
11.     ReDim brr(1 To UBound(arr), 1 To 1)
    
12.     For j = 1 To UBound(arr)
    
13.         brr(j, 1) = d(arr(j, 1))
    
14.     Next j
    
15.     Range("b2").Resize(UBound(brr)) = brr
    
16. End Sub

复制代码

hoogle

请查看附件。

fenglingling

不懂耶，怎么参与讨论，完成任务嘛