¤À§O³æ¿WÀx¦s¦¨EXCELÀÉ

koala2099

½Ð±Ð·|ªº¤j¤jÀ°­Ó¦£~:dizzy:
²Î­p201204¬O¤@¥÷Á`ªí
01¡B02¡B04.....¤À§O¥Nªí¤@­Ó­Ü®w
¨C­Ó­Ü®w¸ê®Æ¶q¤£¦P(¬Ò¦³¤W¤dµ§)
¨ä¤¤ªº­Ü®w¤]¦³¥i¯à·|µL¸ê®Æ
»Ý¨Ì­Ü®w¤À§O³æ¿WÀx¦s¦¨EXCELÀÉ(¥u»Ý¸Ó­Ü®wªº¸ê®Æ)
·í¤ë¦³´X­Ó­Ü®w´N·|¦³´X­ÓEXCELÀÉ

user999

¦^´_ 3# register313


   
¯à¶¶¹D½Ð±Ð¤@¤U,¦pªG°õ¦æ§¹«á©Ò²£¥ÍªºexcelÀÉ,¯à§_¦A°õ¦æ¤@¦¸®É ,¦b¦U¦Ûexcel¤u§@ï·s¼W¤@­Ósheet,¦Ó¤£¬O»\¹L­ìexeclÀÉ®×
ÁÂÁÂ!

koala2099

¦^´_ 4# GBKEE
SORRY~¦£©ó¤u§@
¹L¤F³o»ò¦h¤Ñ¤~¤W¨Ó¦^ÂÐ
­è¸Õ¤F§¹¦¨²Å¦X»Ý¨D
·PÁ¤j¤jªº¨ó§U0.0ºÝ¤È¸`¨Î¸`§Ö¼Ö

GBKEE

¦^´_ 1# koala2099

1. Option Explicit
   
2. Sub Ex()  '¶i¶¥¿z¿ï + ¦Û°Ê¿z¿ï
   
3.     Dim Rng As Range, xi As Integer
   
4.      Application.ScreenUpdating = False
   
5.      With ActiveSheet                     '§@¥Î¤¤ªº¤u§@ªí
   
6.         '¨Ï¥Î AdvancedFilter ¶i¶¥¿z¿ï ¿z¿ï¤£­«´_ªº¸ê®Æ ¨ú±o¦³®Æªº­Ü®w------------
   
7.         '°Ñ¼Æ Action: =xlFilterCopy (½Æ»s¦b§Oªº½d³ò)
   
8.         '°Ñ¼Æ CriteriaRange (·Ç«h½d³ò) ':=.Cells(1, .Columns.Count - 1).Resize(2)  ·Ç«h½d³ò¡C¦pªG¬Ù²¤¦¹¤Þ¼Æ«hµL·Ç«h¡C
   
9.         '·Ç«h½d³ò ªº±ø¥ó¬°ªÅ¥Õ¬°©Ò¦³¿z¿ïªº¸ê®Æ
   
10.         '°Ñ¼Æ CopyToRange  ¿ï¾Ü©Êªº Variant¡C¦pªG Action ¬° xlFilterCopy¡A¦¹¤Þ¼Æ«ü©w³Q½Æ»s¦Cªº¥Ø¼Ð½d³ò¡C§_«h©¿²¤¦¹¤Þ¼Æ¡C
    
11.         '°Ñ¼Æ Unique     ¿ï¾Ü©Êªº Variant¡C­Y¬° True¡A«h¶È¿z¿ï°ß¤@ªº°O¿ý¡F­Y¬° False¡A«h¿z¿ï¥X©Ò¦³²Å¦X·Ç«hªº°O¿ý¡C¹w³]­È¬° False¡C
    
12.         .Cells(1, .Columns.Count - 1) = "aaa"             '
    
13.         .Range("B:B").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Cells(1, .Columns.Count - 1).Resize(2), _
    
14.          CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
    
15.          '------------------------------------------------------------------
    
16.          Set Rng = .Columns(.Columns.Count).SpecialCells(xlCellTypeConstants) '­Ü®w§Oªº½d³ò
    
17.          .AutoFilterMode = False                                              '¨ú®ø ³o¤u§@ªíªº¦Û°Ê¿z¿ï
    
18.          For xi = 2 To Rng.Count                                              '­Ü®wªº°j°é
    
19.             .[A1].AutoFilter Field:=2, Criteria1:=Rng(xi)                     '¦Û°Ê¿z¿ï  ²Ä2Äæ ¤¤  «ü©w ­Ü®w
    
20.             .[A1].CurrentRegion.Copy                                          '½Æ»s¦Û°Ê¿z¿ï¨ìªº¸ê®Æ
    
21.             With Workbooks.Add(1)                                             '·s¶}¬¡­¶Ã¯ ¤u§@ªí1±i
    
22.                 .Sheets(1).Paste                                              '²Ä1±i¤u§@ªí ¶K¤W¸ê®Æ
    
23.                 .Sheets(1).Name = Rng(xi)                                     '²Ä1±i¤u§@ªí ©R¦W:­Ü®w§O
    
24.                 .SaveAs ThisWorkbook.Path & "\" & Rng(xi) & ".xls"            '·s¶}¬¡­¶Ã¯  ¦sÀÉ
    
25.                 .Close                                                        '·s¶}¬¡­¶Ã¯  Ãö³¬
    
26.             End With
    
27.         Next
    
28.         .Cells(1, .Columns.Count - 1).Resize(, 2).EntireColumn.Clear          '²M°£¶i¶¥¿z¿ïªº¸ê®Æ
    
29.     End With
    
30.     Application.ScreenUpdating = True
    
31. End Sub

½Æ»s¥N½X

register313

¦^´_ 1# koala2099

1. Sub NewWb()
   
2.   Set d = CreateObject("Scripting.Dictionary")
   
3.   Application.ScreenUpdating = False
   
4.   Application.DisplayAlerts = False
   
5.   Ar = Sheets("­Ü®w").[A1].CurrentRegion
   
6.   For k = 2 To UBound(Ar)
   
7.       d(Ar(k, 2)) = ""
   
8.   Next
   
9.   For Each dx In d
   
10.       [A1].AutoFilter Field:=2, Criteria1:=dx
    
11.       [A1].CurrentRegion.Copy
    
12.       Workbooks.Add
    
13.       With ActiveWorkbook
    
14.           .ActiveSheet.Paste
    
15.           .ActiveSheet.Name = dx
    
16.           .SaveAs ThisWorkbook.Path & "\" & dx & ".xls"
    
17.           .Close
    
18.       End With
    
19.   Next
    
20.   [A1].AutoFilter
    
21.   Application.DisplayAlerts = True
    
22.   Application.ScreenUpdating = True
    
23.   MsgBox "¤u§@ªí¨Ì±ø¥ó¥t¦s¬¡­¶Ã¯,°õ¦æ§¹²¦!"
    
24. End Sub

½Æ»s¥N½X

hugh0620

¦^´_ 1# koala2099

1. Private Sub CommandButton1_Click()
   
2. '======¿z¿ï¦³´X­Ó­Ü®w===========
   
3.     Sheet1.Range("B2:B65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet1.Range( _
   
4.         "P2"), Unique:=True
   
5.         
   
6. A = Sheet1.Range("P65536").End(xlUp).Row       '¦@¦³´X­Ó­Ü®w
   
7. B = Sheet1.Range("C65536").End(xlUp).Row       '¦@¦³¦h¤Öµ§¸ê®Æ­n³Q°õ¦æ
   
8. With Application.FileDialog(msoFileDialogFolderPicker)
   
9.     If .Show = 0 Then Exit Sub
   
10.     patch = .SelectedItems(1)
    
11.     Application.DefaultFilePath = patch
    
12.     If .ButtonName = "½T©w" Then
    
13.         For I = 2 To A
    
14.             Workbooks.Add
    
15.             ActiveWorkbook.Sheets(1).Name = Sheet1.Range("P" & I)
    
16.             With ActiveWorkbook
    
17.             Sheet1.Range("A1:J1").Copy .Sheets(1).Range("A1")
    
18.             For J = 2 To B
    
19.                 If Sheet1.Range("P" & I) = Sheet1.Range("B" & J) Then
    
20.                    .Sheets(1).Range("A" & 2 + N) = Sheet1.Range("A" & J)
    
21.                    .Sheets(1).Range("B" & 2 + N) = Sheet1.Range("B" & J)
    
22.                    .Sheets(1).Range("C" & 2 + N) = Sheet1.Range("C" & J)
    
23.                    .Sheets(1).Range("D" & 2 + N) = Sheet1.Range("D" & J)
    
24.                    .Sheets(1).Range("E" & 2 + N) = Sheet1.Range("E" & J)
    
25.                    .Sheets(1).Range("F" & 2 + N) = Sheet1.Range("F" & J)
    
26.                    .Sheets(1).Range("G" & 2 + N) = Sheet1.Range("G" & J)
    
27.                    .Sheets(1).Range("H" & 2 + N) = Sheet1.Range("H" & J)
    
28.                    .Sheets(1).Range("I" & 2 + N) = Sheet1.Range("I" & J)
    
29.                    .Sheets(1).Range("J" & 2 + N) = Sheet1.Range("J" & J)
    
30.                    N = N + 1
    
31.                 End If
    
32.             Next
    
33.             .SaveAs Application.DefaultFilePath & "\" & Sheet1.Range("P" & I)
    
34.             .Close
    
35.             End With
    
36.             N = 0
    
37.         Next
    
38.     End If
    
39. End With
    
40. Sheet1.Range("P:P").Delete
    
41. ActiveWorkbook.Save
    
42. End Sub

½Æ»s¥N½X