s7659109

¦pªG ¥u¬O­nÄæ¦ì¶×¤J¡A¤£§PÂ_¡A¤U­±­n¦p¦ó§ï¡H

For Each Rng In Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
        Rng.Offset(0, 1).Resize(1, 7) = d(Rng.Value)
    Next

Kubi

¦^´_ 1# s7659109
½Ð°Ñ¦Ò

1. Sub test() '¦r¨å»P¼Æ²Õ
   
2.     Dim arr
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Dim lastrow&
   
5.     lastrow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
   
6.     arr = Sheet3.Range("a1:h" & lastrow)
   
7.     For i = 2 To UBound(arr)
   
8. '        d(arr(i, 1)) = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7), arr(i, 8))
   
9.         d(arr(i, 1)) = Array(arr(i, 2), arr(i, 3), "", arr(i, 7), arr(i, 8), "", arr(i, 4))
   
10.     Next
    
11.     For Each Rng In Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
    
12.         Rng.Offset(0, 1).Resize(1, 7) = d(Rng.Value)
    
13.     Next
    
14. End Sub

½Æ»s¥N½X