[已解决]数组求助

走进EXCEL

数组求助,详见附件,谢谢!! 求助888.rar (7.85 KB, 下载次数: 9)

2017-4-13 22:36 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

wenzili

2017-4-14 09:44

好像理解反了，修改如下：
Public Sub maseter()
Dim Dic As Object
Dim vaKeyofDic As Variant
Dim i As Long, n As Long
Dim rng As Range
Set Dic = CreateObject("scripting.dictionary")
vaKeyofDic = Intersect(Sheet1.Range("b:b"), Sheet1.UsedRange)
For i = 2 To UBound(vaKeyofDic)
    Dic(vaKeyofDic(i, 1)) = i
Next i
With Sheet2
    For Each rng In .Range("h2", .Range("h2").End(xlDown))
        For n = 4 To 6
            rng.Offset(0, n) = Sheet1.Cells(Dic(rng.Value), n)
        Next n
    Next rng
End With

End Sub

跳转到最佳答案楼层

ghostjiao

vlookup不就行了吗...

Excel学徒123

字典加数组   大炮打蚊子

wenzili

Public Sub maseter()
Dim Dic As Object
Dim vaKeyofDic As Variant
Dim i As Long, n As Long
Dim rng As Range
Set Dic = CreateObject("scripting.dictionary")
vaKeyofDic = Sheet2.Range("h1").CurrentRegion
For i = 2 To UBound(vaKeyofDic)
    Dic(vaKeyofDic(i, 1)) = i
Next i
With Sheet1
    For Each rng In .Range("b2", .Range("b2").End(xlDown))
        For n = 2 To 4
            rng.Offset(0, n) = Sheet2.Cells(Dic(rng.Value), 10 + n)
        Next n
    Next rng
End With

End Sub

wenzili

好像理解反了，修改如下：
Public Sub maseter()
Dim Dic As Object
Dim vaKeyofDic As Variant
Dim i As Long, n As Long
Dim rng As Range
Set Dic = CreateObject("scripting.dictionary")
vaKeyofDic = Intersect(Sheet1.Range("b:b"), Sheet1.UsedRange)
For i = 2 To UBound(vaKeyofDic)
    Dic(vaKeyofDic(i, 1)) = i
Next i
With Sheet2
    For Each rng In .Range("h2", .Range("h2").End(xlDown))
        For n = 4 To 6
            rng.Offset(0, n) = Sheet1.Cells(Dic(rng.Value), n)
        Next n
    Next rng
End With

End Sub

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&, j&, r&
   
3. arr = Sheets(1).[a1].CurrentRegion
   
4. Set d = CreateObject("scripting.dictionary")
   
5. For i = 2 To UBound(arr)
   
6.   d(arr(i, 2)) = i
   
7. Next i
   
8. brr = Range("h2:h" & [h65536].End(3).Row).Resize(, 3)
   
9. For i = 1 To UBound(brr)
   
10.   r = d(brr(i, 1))
    
11.   For j = 1 To 3
    
12.     brr(i, j) = arr(r, j + 3)
    
13.   Next j
    
14. Next i
    
15. [l2].Resize(UBound(brr), 3) = brr
    
16. End Sub

复制代码

走进EXCEL

大灰狼1976 发表于 2017-4-14 14:48

最佳答案应当设为您!谢谢!