¤À³Î¤u§@ªírange©ñÅܼƶi¥h«á°õ¦æ³t«×ÅܺC

lamb22368

¤j®a¦n¡A·Q½Ð±Ð¦b«ü©w¤u§@ªí¸Ìrange¨Ï¥ÎÅܼƮɡA°õ¦æªº³t«×¤£ª¾¬°¦óÅܱo«D±`ºC¡A³s±a§R°£¤u§@ªí®É¤]Åã±o¥d¥dªº¡F
¦ý¦pªG§ï¦¨«ü©w½d³ò³t«×´N«Ü§Ö¡A¦ý¸ê®Æ¤£¤@©w¨C¦¸³£¤@¼Ë¦h¦C¡A·Qª¾¹D¦³¨S¦³¥[§Ö¹B¦æªº¤èªk¡A«D±`·PÁÂ~

¤U¦C³o¨Ç®e©ö©ìºCexcelªº¥\¯à¤]³£¸Õ¹L¡A°õ¦æ°_¨Ó¤@¼Ë«ÜºC...

    Application.Calculation = xlCalculationManual  '¼È°±¤½¦¡¦Û°Ê­pºâ
    Application.ScreenUpdating = False  '¼È°±µe­±§ó·s
    Application.DisplayStatusBar = False '¼È°±ª¬ºA¦C§ó·s
    Application.EnableEvents = False  '¼È°±¨Æ¥ó³B²z
    Application.Interactive = False  '¼È°±¥æ¤¬¼Ò¦¡

§ÚªºÀɮסG[attach]31643[/attach]

lamb22368

ÁV¿|§Ú¤£·|¤W¶Çªþ¥ó
¤À³Î¤u§@ªírange©ñÅܼưõ¦æ³t«×ÅܺC.rar (25.74 KB)

ÀÉ®×
¤U¸ü¦¸¼Æ: 9

2020-1-15 15:57

Public Sub §å¦¸¤À³Î¤u§@ªí()
    '½Æ»s·~°È¨ìZÄæ
    Columns("A:A").Copy
    Columns("Z:Z").Insert shift:=xlToRight

    '²¾°£­«½Æ
    ActiveSheet.Range("Z:Z").RemoveDuplicates Columns:=1, Header:=xlYes

   
    '·s¼W¤u§@ªí
    For i = 2 To Range("Z1").End(xlDown).Row
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheets(1).Cells(i, "Z")
        
        '¤£ª¾¬°¦órange¥áÅܼƶi¥h°õ¦æ³t«×ÅܫܺC
'        r = Range("A1").End(xlDown).Row
'        Sheets(1).Range("A1:U" & r).AutoFilter field:=1, Criteria1:=Sheets(1).Cells(i, "Z") '¿z¿ï³o­Ó¥\¯à¬O¦bRangeª«¥ó©³¤Uªº¤èªk
'        Sheets(1).Range("A1:U" & r).Copy Range("A1")
        
        
        'ª½±µ«ü©w½d³ò¹B¦æ³t«×´N«Ü§Ö
        Sheets(1).Range("A1:U14").AutoFilter field:=1, Criteria1:=Sheets(1).Cells(i, "Z") '¿z¿ï³o­Ó¥\¯à¬O¦bRangeª«¥ó©³¤Uªº¤èªk
        Sheets(1).Range("A1:U14").Copy Range("A1")
    Next
   
    Sheets(1).Select
    Columns("Z").Delete
    Sheets(1).Range("A1:U14").AutoFilter
   
End Sub

jcchiang

¦^´_ 2# lamb22368

§Aªºr¬Oºâ¨ì·s¶}ªºPageªºRow
r = Range("A1").End(xlDown).Row
½Ð§ï¦¨
r = Sheets(1).Range("A1").End(xlDown).Row
¨Ã§ï©ñ¨ì¥~¼h,§_«h·íµ{¦¡°õ¦æ¿z¿ï«ár­È·|¸òµÛ§ïÅÜ,µLªk¿z¿ï¥X¥¿½T¸ê®Æ

Public Sub §å¦¸¤À³Î¤u§@ªí()
    '½Æ»s·~°È¨ìZÄæ
    Columns("A:A").Copy
    Columns("Z:Z").Insert shift:=xlToRight

    '²¾°£­«½Æ
    ActiveSheet.Range("Z:Z").RemoveDuplicates Columns:=1, Header:=xlYes
    r = Sheets(1).Range("A1").End(xlDown).Row
   
    '·s¼W¤u§@ªí
    For i = 2 To Range("Z1").End(xlDown).Row
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheets(1).Cells(i, "Z")
        
        '¤£ª¾¬°¦órange¥áÅܼƶi¥h°õ¦æ³t«×ÅܫܺC
    '    r = Sheets(1).Range("A1").End(xlDown).Row
        Sheets(1).Range("A1:U" & r).AutoFilter field:=1, Criteria1:=Sheets(1).Cells(i, "Z") '¿z¿ï³o­Ó¥\¯à¬O¦bRangeª«¥ó©³¤Uªº¤èªk
        Sheets(1).Range("A1:U" & r).Copy Range("A1")        
        
        'ª½±µ«ü©w½d³ò¹B¦æ³t«×´N«Ü§Ö
'        Sheets(1).Range("A1:U14").AutoFilter field:=1, Criteria1:=Sheets(1).Cells(i, "Z") '¿z¿ï³o­Ó¥\¯à¬O¦bRangeª«¥ó©³¤Uªº¤èªk
'       Sheets(1).Range("A1:U14").Copy Range("A1")
    Next
   
    Sheets(1).Select
    Columns("Z").Delete
    Sheets(1).Range("A1:U14").AutoFilter
   
End Sub

lamb22368

¦^´_ 3# jcchiang


    §Ú²z¸Ñ¤F¡A«D±`·PÁ»¡©ú»P«ü¾É~

­ã´£³¡ªL

Public Sub §å¦¸¤À³Î¤u§@ªí()
Dim xD, xArea As Range, xR As Range
Set xD = CreateObject("Scripting.Dictionary")
Set xArea = Range("U1", Cells(Rows.Count, 1).End(xlUp))
For Each xR In xArea.Columns(1).Cells
    If xR.Row = 1 Or xR = "" Or xD(xR & "") > 0 Then GoTo 101 Else xD(xR & "") = 1
    xArea.AutoFilter field:=1, Criteria1:=xR.Value
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = xR.Value
    xArea.Copy Sheets(xR.Value).[A1]
101: Next
xArea.Parent.Select
ActiveSheet.AutoFilterMode = False
End Sub


'==========================================

lamb22368

¦^´_ 5# ­ã´£³¡ªL


    ÁÂÁª©¥D´£¨Ñ¡ã¦nÄAÂЧڪº¸£³U¡Aµæ³¾§Ú»Ý­n¥J²Ó±ÀºV¡A¦A¦¸·PÁª©¥D¡ã