GBKEE

¦^´_ 3# freeffly
¥t¤@¼gªk

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, i As Integer, PastRng As Range, Ar
   
4.     'Ar = Range("A1").CurrentRegion
   
5.     'Range("A1").CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes
   
6.     '¦p¸ê®Æ¨S¦³±Æ§Ç¥[¥Î¤W­±µ{¦¡½X
   
7.     Set Rng = Range("A2")
   
8.     Set PastRng = Range("F1")
   
9.     PastRng.CurrentRegion = ""
   
10.     i = 2
    
11.     Do While Rng <> ""
    
12.         If Rng(i) <> Rng Then
    
13.             PastRng = Rng
    
14.             PastRng(2).Resize(i - 1) = Range(Rng, Rng(i - 1)).Offset(, 1).Value
    
15.             Set Rng = Rng(i)
    
16.             Set PastRng = PastRng.Offset(, 1)
    
17.             i = 2
    
18.         Else
    
19.             i = i + 1
    
20.         End If
    
21.     Loop
    
22.    'Range("A1").CurrentRegion = Ar    '¦p¸ê®Æ¨S¦³±Æ§Ç¥[¦¹µ{¦¡½X
    
23. End Sub

½Æ»s¥N½X