[µo°Ý] ¦hºû¯x°}ºÃ´b

stephen

Hi ¤j¤j,

ªþ¥ó³o­ÓÀÉ®×,§Ú¥Î°j°é¥h°µ¤@ª½±o¤£¨ì¦³®Ä¸Ñ¨Mªº¤è¦¡.
¥i¯à¦]¬°¤@ª½§ä¤£¨ì¹B§@ÅÞ¿è,¤]³\¥u¯à¥Î¯x°}ªº¤è¦¡¸Ñ¨M
Àµ½Ð¦U¦ì¤j¤j«ü¾É¤@¤G.

¤U¸ü (36.56 KB)

2014-5-24 12:13

ÁÂÁÂ~

stephen

¬d¾\¤F¤@¤Uexcel»¡©ú,¨Ï¥Î Union ¤èªk±N¦h­Ó½d³ò¦X¨Ö¦¨³æ¤@ Range ª«¥ó¡C
......¥u¯à»¡,ª©¥D±z¦n±j~
ÁÂÁÂ~¨ü±Ð¤F!

Hsieh

¦^´_ 1# stephen

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. r = 2
   
4. Do Until Cells(r, 2) = ""
   
5. ar = IIf(InStr(Cells(r, 3), "arr"), Cells(r, 3), ar)
   
6. k = Val(Replace(ar, "arr ", ""))
   
7. If IsEmpty(d(k)) Then Set d(k) = Cells(r, 1).Resize(, 5) Else Set d(k) = Union(d(k), Cells(r, 1).Resize(, 5))
   
8. r = r + 1
   
9. Loop
   
10. [H:L].Clear
    
11. [H1] = "´Á±æµ²ªG"
    
12. s = 1
    
13. For i = 1 To d.Count
    
14.    d(i).Copy [H1].Offset(s)
    
15.    [H1].Offset(s).Resize(d(i).Rows.Count, 3).Sort key1:=[H1].Offset(s, 1), key2:=[H1].Offset(s), Header:=xlYes
    
16.    s = s + d(i).Rows.Count
    
17. Next
    
18. End Sub

½Æ»s¥N½X