Hsieh

¦^´_ 1# tonycho33

1. Sub nn()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. For Each a In Range("C5:H5,C7:H7,C9:H9").SpecialCells(xlCellTypeConstants)
   
4.    If IsEmpty(d(a.Value)) Then d(a.Value) = Cells(a.Row, 2) Else d(a.Value) = d(a.Value) & "," & Cells(a.Row, 2)
   
5. Next
   
6. For Each a In [K5:K9]
   
7. ar = Split(d(a.Value), ",")
   
8.    a.Offset(, 1).Resize(, UBound(ar) + 1) = ar
   
9. Next
   
10. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 3# tonycho33

1. Sub nn()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. For Each a In Range("C5", [A65536].End(xlUp).Offset(, 7)).SpecialCells(xlCellTypeConstants) '¦AB:HÄ檺ªº«DªÅ®æ°µ°j°é
   
4.    If IsEmpty(d(a.Value)) Then d(a.Value) = Cells(a.Row, 2) Else d(a.Value) = d(a.Value) & "," & Cells(a.Row, 2) '¦pªG¥¼¥X²{¹L´N¥H¸ÓÀx¦s®æ¤º®e¥[¤J§_«h´N±N­ì¦³¦r¦ê¥H³rÂI³sµ²¸ÓÀx¦s®æ¤º®e
   
5. Next
   
6. For Each a In Range("k5", [K65536].End(xlUp)) '¦bKÄæ©Ò¦³¸ê®Æ°µ°j°é
   
7. ar = Split(d(a.Value), ",")  '±N¥HKÄæÀx¦s®æ¬°ÃöÁä¦rªº¦r¨å¤º®e¥H³rÂI°µ¤À³Î±o¨ì¤@­Ó°}¦C
   
8. a.Offset(, 1).Resize(, UBound(ar) + 1) = ar '±N°}¦C¼g¤JLÄæ¦V¥k
   
9. Next
   
10. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 5# tonycho33

1. Sub nn()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. For Each a In Range("C5", [A65536].End(xlUp).Offset(, 7)).SpecialCells(xlCellTypeFormulas) '¦AB:HÄ檺ªº¤½¦¡Àx¦s®æ°µ°j°é
   
4.    If a.Value<>"" And IsEmpty(d(a.Value)) Then d(a.Value) = Cells(a.Row, 2) Else d(a.Value) = d(a.Value) & "," & Cells(a.Row, 2) '¦pªG¥¼¥X²{¹L´N¥H¸ÓÀx¦s®æ¤º®e¥[¤J§_«h´N±N­ì¦³¦r¦ê¥H³rÂI³sµ²¸ÓÀx¦s®æ¤º®e
   
5. Next
   
6. For Each a In Range("k5", [K65536].End(xlUp)) '¦bKÄæ©Ò¦³¸ê®Æ°µ°j°é
   
7. ar = Split(d(a.Value), ",")  '±N¥HKÄæÀx¦s®æ¬°ÃöÁä¦rªº¦r¨å¤º®e¥H³rÂI°µ¤À³Î±o¨ì¤@­Ó°}¦C
   
8. a.Offset(, 1).Resize(, UBound(ar) + 1) = ar '±N°}¦C¼g¤JLÄæ¦V¥k
   
9. Next
   
10. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 7# tonycho33

1. Sub nn2()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. For Each a In Range("C5", [O65536].End(xlUp)).SpecialCells(xlCellTypeConstants) '¦bC:OÄ檺ªº«DªÅ®æ°µ°j°é
   
4. If a <> 0 Then
   
5.    If IsEmpty(d(a.Value)) Then d(a.Value) = Cells(a.Row, 2) Else d(a.Value) = d(a.Value) & "," & Cells(a.Row, 2) '¦pªG¥¼¥X²{¹L´N¥H¸ÓÀx¦s®æ¤º®e¥[¤J§_«h´N±N­ì¦³¦r¦ê¥H³rÂI³sµ²¸ÓÀx¦s®æ¤º®e
   
6. End If
   
7. Next
   
8. For Each a In Range("q5", [q65536].End(xlUp)) '¦bKÄæ©Ò¦³¸ê®Æ°µ°j°é
   
9. ar = Split(d(a.Value), ",")  '±N¥HKÄæÀx¦s®æ¬°ÃöÁä¦rªº¦r¨å¤º®e¥H³rÂI°µ¤À³Î±o¨ì¤@­Ó°}¦C
   
10. a.Offset(, 1).Resize(, UBound(ar) + 1) = ar '±N°}¦C¼g¤JLÄæ¦V¥k
    
11. Next
    
12. End Sub

½Æ»s¥N½X