- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¦^´_ 1# missbb
ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
°²´Áªí_20230914.zip (28.8 KB)
°²´Áªí:
°²´Áªí°õ¦æµ²ªG:
°²´Á2ªí:
°²´Á2ªí°õ¦æµ²ªG:
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 |
|