[µo°Ý] ±N­û¤u°²´Á«ö³´Á¨ì¥X¦bÁ~¸ê³æ

missbb

°²´Áªí (2).zip (8.74 KB)

¤U¸ü¦¸¼Æ: 8

2023-9-12 22:56

¥»¤H¦³¤@­Ó¤u§@ªí¬ö¿ý­û¤u¤£¦P¤é´Áªº°²´Á, ¥t¨C¤ë³´Á­nµo¥XÁ~ª÷³æ, ±NÄÝ©ó«ö³´Áªº°²´Á¦C¦bÁ~ª÷³æ, ½Ð°Ý¥Î¨º¤@­Óµ{¥i¥H°µ¨ì?

Ãø«×¬O°²´Á¤é´Á­n»P³´Á(¦p³´Á¬O2023/9/1, ­n±N2023/9/1-2023/9/30¤ºªº°²´Á©â¥X±ø¦C, ¨Ã«ö°²´ÁÃþ§O±Æ¦C)

¨Ò¦p:
AL 2023/9/4 1¤é
SL 2023/9/6  1¤é
AL 2023/9/12 1¤é


­n±Æ¦C¬°
AL 2023/9/4 1¤é
AL 2023/9/12 1¤é
SL 2023/9/6  1¤é

¤Z½Ð«ü¾É

hcm19522

https://hcm19522.blogspot.com/2023/09/11793.html

Andy2483

¦^´_ 1# missbb


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
°²´Áªí_20230914.zip (28.8 KB)

¤U¸ü¦¸¼Æ: 5

2023-9-14 11:03

°²´Áªí:

¤U¸ü (60.04 KB)

2023-9-14 11:04

°²´Áªí°õ¦æµ²ªG:

¤U¸ü (81.27 KB)

2023-9-14 11:04

°²´Á2ªí:

¤U¸ü (111.06 KB)

2023-9-14 11:05

°²´Á2ªí°õ¦æµ²ªG:

¤U¸ü (105.18 KB)

2023-9-14 11:05

Option Explicit
Sub TEST()
Dim Brr, Crr, Z, Q, i&, j%, v&, Y, T$, R&, n%, vD$, xU As Range, w&, xA As Range, Zn%
Set Z = CreateObject("Scripting.Dictionary")
Set Y = CreateObject("Scripting.Dictionary")
Set xA = [µ²ªG!A1]
If Not IsDate([H1]) Then MsgBox "¥ý¿é¤J¥¿½T³´Á": [H1].Activate: Exit Sub
vD = Format([H1], "YYYY/MM")
Brr = Range([D1], Cells(Rows.Count, "A").End(3))
For i = 2 To UBound(Brr)
   If Brr(i, 1) = "" Then GoTo i01 Else Y(Brr(i, 1)) = 0
   If Format(Brr(i, 3), "YYYY/MM") <> vD Then GoTo i01
   If Brr(i, 2) = "NPSL" Then Z(Brr(i, 2) & Brr(i, 3)) = Brr(i, 3): GoTo i01
   R = R + 1: For j = 1 To 4: Brr(R, j) = Brr(i, j): Next
i01: Next
Zn = Z.Count: If Zn = 0 Then MsgBox vD & " ³´Á¨S¦³ NPSL ªº¸ê®Æ": Exit Sub
If R = 0 Then MsgBox "¨S¦³§k¦X³´Áªº¸ê®Æ": Exit Sub
With Sheets("µ²ªG").[A1].Resize(R, 4)
   Union(.Cells, .Offset(0, 2)).EntireColumn.Clear
   .Value = Brr
   .Sort KEY1:=.Item(1), Order1:=1, Key2:=.Item(3), Order2:=1, Header:=2
   .Sort KEY1:=.Item(1), Order1:=1, Key2:=.Item(2), Order2:=1, Header:=2
   Brr = .Value: .Clear
End With
For i = 1 To UBound(Brr)
   T = Brr(i, 1):
   If Y(T & "|") = "" Then Y(T & "|") = i Else Y(T) = Y(T) + 1
Next
Set xU = xA
For Each Q In Y.keys
   If InStr(Q, "|") Then Exit For
   Set xU = Union(xU, xA.Offset(w, 0))
   w = w + 8 + Y(Q) + Zn: If Y(Q) Then w = w + 3
Next
[F1:K45].Copy xU: Application.Goto xA
Set xA = [A1].Resize(w, 6)
For i = 7 To 10: xA.Borders(i).Weight = 4: Next
Crr = xA
w = 0
For Each Q In Y.keys
   If InStr(Q, "|") Then Exit For
   v = 2 + w
   Crr(v, 3) = Q
   v = v + 5
   If Y(Q) Then
      For i = Y(Q & "|") To Y(Q & "|") + Y(Q)
         v = v + 1: For j = 2 To 4: Crr(v, j) = Brr(i, j): Next
      Next
   End If
   For i = 1 To Zn
      n = IIf(Y(Q), 2, 0): n = n + v + i
      Crr(n, 2) = "NPSL": Crr(n, 3) = Z.Items()(i - 1): Crr(n, 4) = 1
   Next
   w = w + 8 + Y(Q) + Zn: If Y(Q) Then w = w + 3
Next
xA = Crr
Set Z = Nothing: Erase Brr, Crr
End Sub