GBKEE

¦^´_ 1# yueh0720

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Ar(), xl As Integer
   
4.     With Sheets(1)                              '²Ä1­Ó¤u§@ªí
   
5.         .AutoFilterMode = False                 '¨ú®ø ³o¤u§@ªíªº¦Û°Ê¿z¿ï
   
6.         Ar = .Range("A1").CurrentRegion.Value   '¸ê®ÆÂà¤J°}¦C
   
7.          .Range("A1").CurrentRegion.Sort Key1:=.Range("H2"), Order1:=xlAscending, Key2:=.Range( _
   
8.             "A2"), Order2:=xlAscending, Header:=xlYes                     '±Æ§Ç
   
9.          .Range("IV:IV") = ""                   '²M°£IVÄæ¸ê®Æ
   
10.          .Columns("H:H").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("IV1"), CriteriaRange:=.Range("IU1:IU2"), Unique:=True
    
11.                                                 'AdvancedFilter ¶i¶¥¿z¿ï: HÄ椣­«½Æ¸ê®Æ  ¿z¿ï¨ì.Range("IV1")
    
12.         xl = 2                                  '±q ²Ä2¦C ¶}©l
    
13.         Do While .Range("IV" & xl) <> ""        '±ø¥ó¦¨¥ß: °õ¦æ°j°é
    
14.             If Sheets.Count < xl Then Sheets.Add , Sheets(Sheets.Count)  '¤u§@ªí¼Æ¤p©óxl:·s¼W¤u§@ªí
    
15.             .Range("A1").AutoFilter Field:=8, Criteria1:=.Range("IV" & xl)      '¦Û°Ê¿z¿ï: ²Ä8Äæ=.Range("IV" & xl)
    
16.             .Range("A1").CurrentRegion.SpecialCells(xlCellTypeConstants).Copy Sheets(xl).[A1] '¿z¿ï¨ìªº¸ê®Æ:½Æ»s¨ì «ü©w¤u§@ªíªº[A1]
    
17.             xl = xl + 1                         '±q²Ä2¦C: ©¹¤U¤@¦C
    
18.         Loop
    
19.         .AutoFilterMode = False
    
20.          .Range("A1").CurrentRegion.Value = Ar  '¨ú¥X°}¦C¸ê®Æ ¸m¦^
    
21.     End With
    
22. End Sub

½Æ»s¥N½X