Hsieh

¦^´_ 5# a703130

1. Sub nn()
   
2. Dim A As Range, Rng As Range, Rng1 As Range, Rng2 As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Range("D:D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   
5. Cells.EntireRow.Hidden = False
   
6. For Each A In Range([D2], [D65536].End(xlUp))
   
7. If d.exists(A.Value) = False Then
   
8.    d(A.Value) = A.Value
   
9.    If Rng2 Is Nothing Then Set Rng2 = A Else Set Rng2 = Union(A, Rng2)
   
10. End If
    
11.   If A = A.Offset(1, 0) Then
    
12.      If Rng Is Nothing Then Set Rng = A Else Set Rng = Union(A, Rng)
    
13.      Else
    
14.      If Rng1 Is Nothing Then Set Rng1 = A.Offset(1, 0) Else Set Rng1 = Union(A.Offset(1, 0), Rng1)
    
15.    End If
    
16. Next
    
17. Rng1.EntireRow.Insert
    
18. Rng.EntireRow.Hidden = True
    
19. Rng2.EntireRow.Hidden = False
    
20. End Sub

½Æ»s¥N½X

¤U¸ü (19.9 KB)

2011-10-31 15:30

Hsieh

¦^´_ 7# a703130

³o¨ÃµL¯S®í»yªk
½Ð°w¹ï¤£¸Ñ¤§³Bµo°Ý