¦p¦ó±N§Ç¸¹(Äx¸¹)B2§ï¬°ºI¨úC2³Ì«á2¼Æ¬°§Ç¸¹(Äx¸¹)
±NÄx¸¹(§Ç¸¹)(BÄæ)§ó§ï¥H½s¸¹(CÄæ)«á2¦ì¼Æ
¦p«á±¦³S«h¥HS«e2¦ì¼Æ
Sub ¬£¨®ªí_¿é¤J()
Dim DD, CC$, Arr, Brr, i&, j%, N&, xD
Call ¬£¨®ªí_²M°£
DD = [D1]: CC = [B1]
If Not IsDate(DD) Then MsgBox "**½Ð¿é¤J¤é´Á!! ": Exit Sub
If CC = "" Then MsgBox "**½Ð¿é¤J[¨®½s]!! ": Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([¤u§@ªí2!L1], [¤u§@ªí2!A65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 4)
For i = 2 To UBound(Arr)
If Arr(i, 12) <> DD Or Arr(i, 10) <> CC Then GoTo 101
PNo = Arr(i, 11): If xD(PNo) = 1 Then GoTo 101
xD(PNo) = 1: N = N + 1: Arr(N, 2) = Format(N, "00") '¦³¸ê®Æ®ÉArrªº²Ä2Äæ¦ì¡A¦Û°Ê²£¥Í§Ç¸¹
For j = 1 To 4
Brr(N, 1) = Arr(i, 1)
Brr(N, 3) = Arr(i, 2)
Brr(N, 2) = Arr(N, 2)
Next j
Brr(N, 4) = Arr(i, 11)
101: Next i
If N = 0 Then MsgBox "**¨S¦³²Å¦Xªº¸ê®Æ!! ": Exit Sub
With Sheets("¤u§@ªí1")
.[A3].Resize(N, UBound(Brr, 2)) = Brr
.Range("A1:G" & N + 3).Name = "'" & .Name & "'!Print_Area"
.Range("1:3").Name = "'" & .Name & "'!Print_Titles"
End With
End Sub
¬£¨®ªí§Ç¸¹×q.zip (43.86 KB)
|