ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

¦p¦ó±N¤@­Óexcel ©î¦¨¼Æ­Óexecl

¦p¦ó±N¤@­Óexcel ©î¦¨¼Æ­Óexecl

¥»©«³Ì«á¥Ñ GBKEE ©ó 2012-7-23 15:04 ½s¿è

½Ð±Ð¦U¦ì¥ý¶i  
1.¦p¦ó±N¤@­Óexcel ©î¦¨¼Æ­Óexecl,¦pÁ`ªíexcel¤º®e¦³¦n´X­Ó¯Z¡A¦p¦ó©î¦¨¨C¯Z¤@­ÓexcelÀÉ
2.¦pªG¥i¥H, ¤S±N¨Æ«á ¦U¯ZexeclÀÉ(¥[¤J¦¨ÁZ),¤S¶×¦¨¤@­ÓÀɦpÁ`ªí¤¤ªºµ²ªG
½Ð¨D¨ó§U ÁÂÁÂ!

1toall.rar (32.51 KB)

max

¦^´_ 1# user999
  1. Option Explicit
  2. Sub Ex() 'Á`ªí©î¦¨¼Æ­Óexecl : Á`ªí»P¦U¦~¯Å¬¡­¶Ã¯ ¦s¦b¦P¤@­Ó¸ê®Æ§¨
  3.     Dim wSh As Worksheet, i As Integer, wB As Workbook
  4.     Application.DisplayAlerts = False
  5.     Application.ScreenUpdating = False
  6.     Set wSh = Workbooks("Á`ªí.xlsm").Sheets(1)                             '*** Á`ªí¤w¬O¶}±Òªº ****
  7.     With wSh
  8.         .Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
  9.         'AÄæ¶i¶¥¿z¿ï  :->  ¨S¦³¿z¿ï·Ç«h(CriteriaRange),¥i¿z¿ï¥X¤£­«ÂЪº¸ê®Æ
  10.         i = 2
  11.         .AutoFilterMode = False                                             '¨ú®ø [¦Û°Ê¿z¿ï]
  12.         Do While .Cells(i, .Columns.Count) <> ""                            'ª½¨ì¨S¸ê®Æ
  13.             Set wB = Workbooks.Add(1)   '=°Ñ¼Æ:xlWBATWorksheet              '·s¼W¬¡­¶Ã¯(¤@±i¤u§@ªí)
  14.             .Cells(1).AutoFilter 1, .Cells(i, .Columns.Count)               '[¦Û°Ê¿z¿ï] ²Ä1Äæ ·Ç«h=.Cells(i, .Columns.Count)
  15.             .Range("A1").CurrentRegion.Copy wB.Sheets(1).[a1]               '[¦Û°Ê¿z¿ï]¨Ì·Ç«h¿z¿ïªº¸ê®Æ ½Æ»s¨ì Á`ªí
  16.             wB.SaveAs wSh.Parent.Path & "\" & .Cells(i, .Columns.Count) & ".xlsx", FileFormat:=51   '51: ¦sÀɬ° 2007 µL¥¨¶°¬¡­¶Ã¯
  17.             wB.Close                                                        'Ãö³¬ÀÉ®×
  18.             i = i + 1                                                       '¤U¤@¦C¸ê®Æ
  19.         Loop
  20.         .AutoFilterMode = False
  21.         .Cells(1, .Columns.Count).EntireColumn = ""                         '¤u§@ªí³Ì«á¤@Äæ:²M°£¿z¿ï¥X¤£­«ÂЪº¸ê®Æ
  22.      End With
  23.     Application.DisplayAlerts = True
  24.     Application.ScreenUpdating = True
  25. End Sub
  26. Sub Ex1() '¼Æ­Óexecl µ²¦X¬°Á`ªí:   Á`ªí»P¦U¦~¯Å¬¡­¶Ã¯ ¦s¦b¦P¤@­Ó¸ê®Æ§¨
  27.     Dim wB As Workbook, wSh As Worksheet, xF As String
  28.     Application.ScreenUpdating = False
  29.     Set wSh = Workbooks("Á`ªí.xlsm").Sheets(1)
  30.     With wSh
  31.         .Range("a1").CurrentRegion.Offset(1).Clear
  32.         xF = Dir(wSh.Parent.Path & "\*.xlsx")               '´M§ä wSh.Parent.Path ³o¸ê®Æ§¨ °ÆÀɦW¬°xlsx ªºÀÉ®×
  33.         Do While xF <> ""
  34.             With Workbooks.Open(wSh.Parent.Path & "\" & xF).Sheets(1)
  35.                 .Range("a1").CurrentRegion.Offset(1).Copy wSh.Cells(wSh.Rows.Count, 1).End(xlUp).Offset(1)
  36.                 .Parent.Close False
  37.             End With
  38.             xF = Dir
  39.         Loop
  40.         .Range("A1").CurrentRegion.Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range( _
  41.         "B2"), Order2:=xlAscending, Key3:=.Range("C2"), Order3:=xlAscending, _
  42.         Header:=xlYes, OrderCustom:=1
  43.         .Parent.Save
  44.     End With
  45.     Application.ScreenUpdating = True
  46. End Sub
½Æ»s¥N½X

TOP

¦^´_ 2# GBKEE


    ÁÂÁ±z³o»ò¸ÔºÉ§Ö³tªº¦^ÂÐ,¦³±z­ÌÀ°§U¯u¦n,ÁÂÁÂ!
max

TOP

¯uªº¬O°ª¤â
vba¡A§ÚÁÙ¬O»Ý­n¦n¦n¾Ç²ß

TOP

        ÀR«ä¦Û¦b : §Ñ¥\¤£§Ñ¹L¡A§Ñ«è¤£§Ñ®¦¡C
ªð¦^¦Cªí ¤W¤@¥DÃD