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

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

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

¥Ø«e¶·¤â°Ê«Ø¥ß¿z¿ïÄæ¦ì¤ºªº¤À­¶¤~¯à¦Û°Ê¾É¤J¸ê®Æ
  1. Sub Ex()
  2.     Dim Sh As Worksheet
  3.     With Sheets("·JÁ`©ú²Ó")
  4.         For Each Sh In Sheets          'Sheets : ¤u§@ªíª«¥óªº¶°¦Xª«¥ó
  5.             If Sh.Name <> .Name Then   '¤u§@ªíªº¦WºÙ<>"·JÁ`©ú²Ó"
  6.                 .Range("A1").AutoFilter Field:=2, Criteria1:=Sh.Name
  7.                 '"·JÁ`©ú²Ó" ¦Û°Ê¿z¿ï  ¿z¿ï°ò·ÇÄæ¦ì:=²Ä2Äæ , ¿z¿ï·Ç«h:="¤u§@ªí¦WºÙ"
  8.                 .UsedRange.Columns("a:d").Copy Sh.[a1] '"·JÁ`©ú²Ó" ¦Û°Ê¿z¿ï«áªº¸ê®Æ, ½Æ»s
  9.             End If
  10.         Next
  11.         .Range("A1").AutoFilter   '¨ú®ø "·JÁ`©ú²Ó"¦Û°Ê¿z¿ï¼Ò¦¡
  12.     End With
  13. End Sub
½Æ»s¥N½X

Sub test()
Dim Sht As Worksheet, xD, xR As Range
Set xD = CreateObject("Scripting.Dictionary")
xD("") = 1
With Sheets("·JÁ`©ú²Ó").UsedRange
¡@¡@For Each xR In .Columns(2).Offset(1, 0).Cells
¡@¡@¡@¡@If xD(xR.Value) = "" Then
¡@¡@¡@¡@¡@On Error Resume Next
¡@¡@¡@¡@¡@Set Sht = Sheets(xR.Value)
¡@¡@¡@¡@¡@On Error GoTo 0
¡@¡@¡@¡@¡@If Sht Is Nothing Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = xR.Value
¡@¡@¡@¡@¡@.AutoFilter Field:=2, Criteria1:=xR.Value
¡@¡@¡@¡@¡@.Columns("a:d").Copy Sheets(xR.Value).[a1]
¡@¡@¡@¡@¡@xD(xR.Value) = 1: Set Sht = Nothing
¡@¡@¡@¡@End If
¡@¡@Next
¡@¡@Application.Goto .Item(1)
End With
Sheets("·JÁ`©ú²Ó").AutoFilterMode = False
End Sub
¡@

TOP

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

¤Ó·PÁ§A¤F¡I¡I¡I¡I¡I¡I¡I¡I¡I¡I¡I¡I¡I¡I¡I¡I¡I¡I

TOP

¶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

¦^´_ 4# GBKEE

·PÁª©¤j~§V¤O§l¦¬¡I¡I¡I

TOP

        ÀR«ä¦Û¦b : ¡i¥Í©R¦b©I§l¶¡¡j¦òªû»¡¡G¡u¥Í©R¦b©I§l¶¡¡C¡v¤HµLªkºÞ¦í¦Û¤vªº¥Í©R¡A§óµLªk¾×¦í¦º´Á¡AÅý¦Û¤v¥Ã¦í¤H¶¡¡C¬JµM¥Í©R¥h¨Ó³o»òµL±`¡A§Ú­Ì§óÀ³¸Ó¦n¦n¦a·R±¤¥¦¡B§Q¥Î¥¦¡B¥R¹ê¥¦¡AÅý³oµL±`¡BÄ_¶Qªº¥Í©R¡A´²µo¥¦¯uµ½¬üªº¥ú½÷¡A¬M·Ó¥X¥Í©R¯u¥¿ªº»ù­È¡C
ªð¦^¦Cªí ¤W¤@¥DÃD