GBKEE

Hello Luhpro,  ÁÂÁ§AªºÀ°¦£, µ{¦¡¶]¨ì¤@¥b¥X²{§ä¤£¨ìY­Ècw3076 µoªí©ó 2011/5/1 12:45

¤£·|ªü !!! ,¥t¦³¤@¸Ñ, ¸Õ¸Õ¬Ý.

1. Sub Ex()
   
2.     Dim i As Integer, ii As Integer, Rng As Range, A%, x%
   
3.     ReDim Ar%(2, A)
   
4.     ReDim Xy&(1, x)
   
5.     With ActiveSheet.[C:C].SpecialCells(xlCellTypeConstants)
   
6.         If Not ActiveSheet.AutoFilter Is Nothing Then .AutoFilter
   
7.         For i = Application.Min([C:C]) To Application.Max([C:C])
   
8.             .Cells(1).AutoFilter Field:=2, Criteria1:=i
   
9.             Set Rng = .SpecialCells(xlCellTypeVisible)
   
10.             Set Rng = Rng.Areas(Rng.Areas.Count).Offset(, -1)
    
11.             Ar(0, A) = i
    
12.             Ar(1, A) = Application.Min(Rng)
    
13.             Ar(2, A) = Application.Max(Rng)
    
14.             For ii = Ar(1, A) To Ar(2, A)
    
15.                 If Rng.Find(ii) Is Nothing Then
    
16.                     Xy(0, x) = ii
    
17.                     Xy(1, x) = i
    
18.                     x = x + 1
    
19.                     ReDim Preserve Xy(1, x)
    
20.                 End If
    
21.             Next
    
22.             A = A + 1:   ReDim Preserve Ar(2, A)
    
23.         Next
    
24.         .Cells(1).AutoFilter
    
25.     End With
    
26.     ActiveSheet.[E2].Resize(A, 3) = Application.Transpose(Ar)
    
27.     ActiveSheet.[I2].Resize(x, 2) = Application.Transpose(Xy)
    
28. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 6# cw3076
¨C¤@­Óµ{§Ç³£¬O¨Ì¤£¦P»Ý¨D¦Ó¶q¨­­q§@¡@
   

1. Sub Ex()
   
2.     Dim i As Integer, ii As Integer, Rng As Range, A%, x%
   
3.     ReDim Ar%(2, A)
   
4.     ReDim Xy%(1, x)
   
5.     With ActiveSheet.[C:C].SpecialCells(xlCellTypeConstants)
   
6.          .Cells(1).CurrentRegion.Sort Key1:=.Cells(1), Header:=xlYes, Order1:=xlAscending
   
7.          ' CÄ檺³sÄò½d³ò°µ±Æ§Ç
   
8.         If Not ActiveSheet.AutoFilter Is Nothing Then .AutoFilter  'ActiveSheet¦p¦³¦Û°Ê¿z¿ï «h¨ú®ø
   
9.         For i = Application.Min([C:C]) To Application.Max([C:C])
   
10.             .Cells(1).AutoFilter Field:=3, Criteria1:=i   ' CÄ檺³sÄò½d³ò°µ¦Û°Ê¿z¿ï  
    
11.             '''''''''­×§ï Field:= 3   Y¬°¦Û°Ê¿z¿ïªº²Ä3­ÓÄæ¦ì'''''''''
    
12.             Set Rng = .SpecialCells(xlCellTypeVisible)
    
13.             Set Rng = Rng.Areas(Rng.Areas.Count).Offset(, -1)
    
14.             Ar(0, A) = i
    
15.             Ar(1, A) = Application.Min(Rng)
    
16.             Ar(2, A) = Application.Max(Rng)
    
17.             For ii = Ar(1, A) To Ar(2, A)
    
18.                 If IsError(Application.Match(ii, Rng, 0)) Then
    
19.                 'If Rng.Find(ii) Is Nothing Then  §ï¥ÎMatch³t«× §Ö¤@¨Ç
    
20.                     Xy(0, x) = ii
    
21.                     Xy(1, x) = i
    
22.                     x = x + 1
    
23.                     ReDim Preserve Xy(1, x)
    
24.                 End If
    
25.             Next
    
26.             A = A + 1:   ReDim Preserve Ar(2, A)
    
27.         Next
    
28.         .Cells(1).AutoFilter
    
29.     End With
    
30.     ActiveSheet.[E2].Resize(A, 3) = Application.Transpose(Ar)
    
31.     ActiveSheet.[I2].Resize(x, 2) = Application.Transpose(Xy)
    
32. End Sub

½Æ»s¥N½X