Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß¨ì«Ü¦hª¾ÃÑ,¥H1#½d¨Òªº¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

³æ»ù¤ÀªR¤Àªí:

¤U¸ü (131.18 KB)

2023-12-6 10:32

³æ»ù¤ÀªRÁ`ªí°õ¦æµ²ªG:

¤U¸ü (120.75 KB)

2023-12-6 10:32

Option Explicit
Sub TEST()
Dim Z, Q, i&, R&, V&, c%, xR As Range, xA As Range, Sh As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
Set Sh = ¤u§@ªí1: Range(Sh.[A1], Sh.UsedRange).Offset(5).Delete
Set xR = [³æ»ù¤ÀªRÁ`ªí!B6]
For i = 0 To 10: Z(Right(Application.Text(i, "[DBNum1]"), 1)) = i: Next
For i = 1 To Worksheets.Count
   If Right(Trim(Sheets(i).Name), 5) <> "-³æ»ù¤ÀªR" Then GoTo i01
   Q = Trim(Sheets(i).[B2]) & "¡³¡³¡³"
   For c = 1 To 3: V = Val(V & Z(Mid(Q, c, 1))): Next
   Set Z(V) = Sheets(i): V = 0
i01: Next
For i = 1 To Z.Count
   Q = Application.Small(Z.Keys, i)
   If IsError(Q) Then Exit For
   Set xA = Range(Z(Q).[B2], Z(Q).[G65536].End(3)(1, 2))
   xA.Copy xR
   Set xR = xR.Item(xA.Rows.Count + 2)
Next
With Sh.UsedRange: .Font.ColorIndex = 1: .Value = .Value: End With
Range(Sh.[A1], xR(-1, 8)).Name = "Print_Area"
End Sub