| ©«¤l4901 ¥DÃD44 ºëµØ24 ¿n¤À4916 ÂI¦W267  §@·~¨t²ÎWindows 7 ³nÅ骩¥»Office 20xx ¾\ŪÅv150 ©Ê§O¨k ¨Ó¦Û¥x¥_ µù¥U®É¶¡2010-4-30 ³Ì«áµn¿ý2025-10-31 
                
 | 
                
| ¦^´_ 1# luke ½Æ»s¥N½XSub ex()
Dim ay(2, 11)
Set d = CreateObject("Scripting.Dictionary")
With sheet2
For Each a In .Range(.[A2], .[A2].End(xlDown))
   d(a.Value) = a.Offset(, 1).Value
Next
End With
With sheet1
.[B1:k1].Copy .[B14]: r = 15
For Each a In .Range(.[A2], .[A2].End(xlDown))
  ar = a.Resize(, 11).Value
  For i = 1 To 11
    ay(0, i - 1) = ar(1, i)
    ay(1, i - 1) = d(ar(1, i))
  Next
  .Cells(r, 1).Resize(2, 11) = ay
  r = r + 3
  Erase ay
Next
End With
End Sub
 | 
 |