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

[µo°Ý] Sheet¤¤ªº­È,¨ÌAÄ椤ªº³¡ªù½Æ»s¦Ü·sªºSheet

[µo°Ý] Sheet¤¤ªº­È,¨ÌAÄ椤ªº³¡ªù½Æ»s¦Ü·sªºSheet

½Ð°Ý¦U¦ì,¦³¨º¦ì¥i¥HÀ°À°¦£.

°ÝÃD:§Ú¦³¤@­Ósheet¤¤­n¨Ì³¡ªù¸ê®Æ,¦Û°Ê©î¤À¦¨¦h­Ósheet©Î¦h­Óxls
     ¨ä¤¤¸ê®Æ¬O¥H³¡ªù±Æ§Ç,¬Û¦Pªº³¡ªù»Ý²£¥Ísheet©Î¤@­Óxls(ÀɦW¨Ì³¡ªù¦WºÙ©R¦W)

¥H¤WÁٷнЦU¦ì°ª¤âÀ°¦£¸Ñ´b!
ÁÂÁÂ!

¸ê®Æ³B²z.rar (7.25 KB)

Excel

JH8888

¦^´_ 1# JH8888
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, S As String, xi As Integer
  4.     Application.DisplayAlerts = False                                          ' Microsoft Excel Åã¥Ü¯S©wªºÄµ§i©M°T®§«h¬° True¡CŪ/¼g Boolean
  5.     Application.ScreenUpdating = False                                         '¦pªG¿Ã¹õ§ó·s¥\¯à¬O¶}±Òªº«h¬° True¡CŪ/¼g Boolean¡C
  6.     With Sheets("Sheet1")
  7.         For xi = Sheets.Count To 1 Step -1
  8.             If Sheets(xi).Name <> .Name Then Sheets(xi).Delete                  '§R°£ ­ì¦³ÀÉ®× ¶·¥Ñ«á©¹«e§R
  9.         Next
  10.         If .AutoFilterMode Then .AutoFilterMode = False                         '¨ú®ø¿z¿ï
  11.         .Range("a1").AutoFilter                                                 '[¦Û°Ê¿z¿ï] ¿z¿ï¥X¤@­Ó²M³æ
  12.         Set Rng = .AutoFilter.Range.Columns(1).Cells                            '[¦Û°Ê¿z¿ï]ªº²Ä1Äæ
  13.         For xi = 2 To Rng.Count                                                  '³B¸Ì:  ²Ä1Äæ
  14.             If InStr(S, "," & Rng(xi) & ",") = False Then                        'Àˬd  ¬O§_¤w¥X²{¹L
  15.             .Range("a1").AutoFilter Field:=1, Criteria1:=Rng(xi)                 '¨S¥X²{: «ü©w¬°¿z¿ï­È
  16.             S = S & "," & Rng(xi) & ","                                          '¥[¤J¤w¥X²{¹Lªº¦r¦ê¤¤
  17.             Sheets.Add , Sheets(Sheets.Count)                                   '·s¼W¤@¤u§@ªí
  18.             ActiveSheet.Name = Rng(xi)                                           '©R¦W:¿z¿ï­È
  19.             .UsedRange.SpecialCells(xlCellTypeVisible).Copy ActiveSheet.[a1]    '½Æ»s: ¸ê®Æªí¤¤¿z¿ï¥Xªº¸ê®Æ ->·s¤u§@ªíªº[A1]
  20.             ActiveSheet.Cells.Columns.AutoFit                                   'AutoFit: ±N½d³ò¤¤ªºÄæ¼e©M¦C°ª½Õ¾ã¬°³Ì¾A·íªº­È¡C
  21.             End If
  22.         Next
  23.         .AutoFilterMode = False                                                  '¨ú®ø¿z¿ï
  24.         .Activate                                                                '¦^¨ì ¸ê®Æªí
  25.     End With
  26.     Application.ScreenUpdating = True
  27.     Application.DisplayAlerts = True
  28. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ JH8888 ©ó 2012-2-15 10:05 ½s¿è

¦hÁª©¥D¸Ñ±Ï,¾Ç²ß¤F,§â¥¨¶°¥[¤J¤F,¨Ã¥[¤W¥i¥HÂà¦s¦¨­Ó§Oxls
·PÁÂ!

¦n¤[¨S¨Ó³o¸Ì¤F°Ú,³s±b¸¹³£­n­«¨Ó¤F°Ú!
³o¸Ì¤´¬OVBA¥æ¬yªº­º¿ï.:)

¸ê®Æ³B²z.rar (22.54 KB)

§ó·s

JH8888

TOP

¦^´_ 3# JH8888
¬Ý¨ì§AªþÀɪº Sub Copy_Every_Sheet_To_New_Workbook()
§Ú«Ü¦n©_,§A¥i¥H¦Û¤v¼g¬°¦óÁÙ­nµo°Ý!

TOP

§Ú¥»¨­¹ïVBAºâ¬Oªì¯Å¯Z,µ{¦¡½X¤j¬ù¬ÝªºÀ´,
¦³¤@°}¤l¨S¸IVBA¤F,¥u¬O­è¦n¦³³o­Ó¥\¯àªº»Ý¨D,google»`¤F¤@¤U¨S¤°»òÃþ¦üªº,
¦pªG¦³§ä¨ìÃþ¦üªº§Ú§ï§ïÁÙ¥i¥H,¦ý­n·s«Ø´N¦³ÂI§xÃø,
­è¦n¤S»`¨ì³o­Óºô¯¸,¤~µo²{§Ú´¿¸g¦b³oµù¥U¹L,¦ý±b¸¹¦ü¥G¿ù¹LÂà´«´Á¤F°Ú!
VBAªº«ü¥O³¡¥÷¤´¤£¤Ó¼ô±x,Á٫ܦh­n¾Ç²ßªº¦a¤è,
¥t¥~¨º­Ó¥\¯à¤]¬O¦bgoogle»`¨ìªº,¨Ã§â¥L¥[¤J¤À¨Éµ¹¨ä¥L¦p¦³»Ý­nªº¤H¥i¥H¤@°_¥Î.
·PÁ§A¼ö¤ßªº¦^´_.
JH8888

TOP

a very good practice for beginner like me. Thx

TOP

¥H«e§Ú¤]¦³°Ý¹L¬ÛÃþ¦üªº°ÝÃD~ ¤]¬OG¤j¤jÀ°¦£¨ó§U¸Ñ´b~
¦Û¤v¤]¨Ì¦¹¦Û¦æ­×§ï~ §¹¦¨¸Ó¤u§@~
´£¨Ñµ¹±z°Ñ¦Ò~
http://forum.twbts.com/viewthread.php?tid=2855&highlight=
¾Ç²ß¤~¯à´£¤É¦Û¤v

TOP

        ÀR«ä¦Û¦b : ÁÀ¨¥¹³¤@¦·²±¶}ªºÂAªá¡A¥~ªí¬üÄR¡A¥Í©Rµu¼È¡C
ªð¦^¦Cªí ¤W¤@¥DÃD