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

[µo°Ý] ¦Û°Ê¾ã²z¸ê®Æ

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P±Æ§Ç,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Application.ScreenUpdating = False
Dim Brr, Crr, Y, Z, R&, C&, i&, j&, T$
Dim xR As Range, Sh As Worksheet
ReDim Crr(1 To 1000, 1 To Columns.Count - 1)
For Each Sh In Sheets
   If InStr(Sh.Name, "¯¸") = 1 Then
      Set xR = Intersect(Sh.UsedRange, Sh.[U:Y]): Brr = xR
      For C = 1 To UBound(Brr, 2)
         If Brr(1, C) = "" Then GoTo i01 Else: j = j + 1: i = 0
         For R = 1 To UBound(Brr)
            T = Brr(R, C)
            If R = 1 Then T = Left(T, 3) & Format(Mid(T, 4), "00")
            If T <> "" Then i = i + 1: Crr(i, j) = T
         Next
         If i > Z Then Z = i
i01:  Next
   End If
Next
With Sheets("·JÁ`").[A1].Resize(Z, j)
   .CurrentRegion.Clear
   .Value = Crr
   .Sort Key1:=.Item(1), Order1:=1, Header:=2, Orientation:=2
   For C = 1 To j
      Intersect(.Cells, .Item(C).EntireColumn).Sort _
      Key1:=.Item(C), Order1:=1, Header:=1, Orientation:=1
   Next
End With
Set Sh = Nothing: Set xR = Nothing: Erase Brr, Crr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¡i°µ¤Hªº¶}©l¡j¨C¤@¤Ñ³£¬O¬G¤Hªº¶}©l¡A¨C¤@­Ó®É¨è³£¬O¦Û¤vªºÄµ±§¡C
ªð¦^¦Cªí ¤W¤@¥DÃD