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

[µo°Ý] ½Ð°Ý¦p¦ó¨Ì¿z¿ïÄ檺Ãþ§O,¦Û°Ê«Ø¥ß¤À­¶«Ø¥ß«á¨Ã¤ÀÃþ¸ê®Æ?

¶i¶¥¿z¿ï+¦Û°Ê¿z¿ï
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh As Worksheet, Ar As Variant, i As Integer, M As Variant
  4.     With ActiveWorkbook.Sheets("·JÁ`©ú²Ó")
  5.         .Range("b:b").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
  6.         With .Cells(1, .Columns.Count).EntireColumn
  7.             Ar = .SpecialCells(xlCellTypeConstants)
  8.             Ar = Application.WorksheetFunction.Transpose(Ar)
  9.             .Cells = ""
  10.         End With
  11.         On Error GoTo Sheet_Add   '³B¸Ì¤u§@ªí¤£¦s¦bªº¿ù»~
  12.         For i = 2 To UBound(Ar)
  13.             .Range("A1").AutoFilter Field:=2, Criteria1:=Ar(i)
  14.             .UsedRange.Columns("a:d").Copy ActiveWorkbook.Sheets(Ar(i)).[a1] '"·JÁ`©ú²Ó" ¦Û°Ê¿z¿ï«áªº¸ê®Æ, ½Æ»s
  15.         Next
  16.         .Range("A1").AutoFilter   '¨ú®ø "·JÁ`©ú²Ó"¦Û°Ê¿z¿ï¼Ò¦¡
  17.         .Activate
  18.         On Error GoTo 0             'µ{¦¡¦³¿ù»~¤£³B¸Ì
  19.         '§R°£¤u§@ªí¤£¦s"·JÁ`©ú²Ó"¿z¿ïÄ檺Ãþ§O
  20.         Application.DisplayAlerts = False
  21.         For Each Sh In ActiveWorkbook.Sheets
  22.             If Sh.Name <> .Name Then If IsError(Application.Match(Sh.Name, Ar, 0)) Then Sh.Delete
  23.         Next
  24.         Application.DisplayAlerts = True
  25.     End With
  26.     Exit Sub
  27. '******************************
  28. Sheet_Add:
  29.      ActiveWorkbook.Sheets.Add.Name = Ar(i)
  30.     Resume
  31. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : §g¤l¥ß«í§Ó¡A¤p¤H«í¥ß§Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD