- ©«¤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
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-21 14:03 ½s¿è
¦^´_ 3# shuo1125
ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹¥DÃD½m²ß°}¦C»P¦r¨åªº¸Ñ¨M¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, A, Y, Z, Yk, T$, T2$, T3$, T9$, T10$, S1$, S2$
Dim x%, C%, N&, i&, P&, B(3), Crr(1 To 1000, 1 To 20)
Set Y = CreateObject("Scripting.Dictionary")
Z = Array(, 4, 8, 10, 12, 14, 16, 15, 17)
Brr = Sheets("¸ê®Æ°Ï").UsedRange
For i = 2 To UBound(Brr)
T2 = Brr(i, 2): T3 = Brr(i, 3)
S1 = T2 & "|" & T3: Y(S1 & "/b") = T2: Y(S1 & "/c") = T3
A = Y(S1)
If Not IsArray(A) Then A = Crr
T9 = Brr(i, 9)
B(1) = Mid(T9, 1, 3): B(2) = Mid(T9, 4, 2): B(3) = Mid(T9, 6, 2)
B(0) = B(1) & "." & B(2) & "." & B(3) & "#" & Val(Mid(T9, 8))
T10 = Brr(i, 10)
If T10 Like "¨R*" = False Then
N = Y(S1 & "|r")
N = N + 1
Y(S1 & "|r") = N
S2 = B(0) & "-" & T10: Y(S2) = N
For x = 1 To 4: A(N, x) = Brr(i, Z(x)): Next
For x = 5 To 6
A(N, x) = Brr(i, Z(x)) + Brr(i, Z(x + 2))
A(N, x + 14) = A(N, x)
Next
Y(S1) = A
GoTo i01
ElseIf T10 Like "*¤ë±b´Ú" Then
B(0) = Mid(Split(T10, "¤ë")(0), 2)
B(0) = B(0) & Replace(T10, "¨R", ".#0-")
B(0) = Replace(B(0), "¤ë±b´Ú", "À³¥I±b´ÚÁ`ÃB")
ElseIf T10 Like "¨R###/*#/*#*" Then
B(1) = Mid(T10, 2, 4)
B(2) = Format(Split(Mid(T10, 6), "#")(0), "MM/DD")
B(3) = "#" & Split(T10, "#")(1)
B(0) = Replace(B(1) & B(2) & B(3), "/", ".")
ElseIf T10 Like "¨R?????* ###/*#/*#" Then
B(0) = Split(Mid(T10, 3), " ")
B(1) = Mid(Brr(i, 11), 1, 3)
B(2) = "." & Mid(Brr(i, 11), 4) & ".#0-"
B(3) = B(0)(0) & " " & B(0)(1)
B(0) = B(1) & B(2) & B(3)
End If
C = Format(Brr(i, 4), "M") + 6
A(Y(B(0)), C) = Brr(i, 16) + Brr(i, 17)
A(Y(B(0)), 20) = A(Y(B(0)), 20) - A(Y(B(0)), C)
P = Brr(i, 14) + Brr(i, 15)
A(Y(B(0)), 19) = A(Y(B(0)), 19) - P
Y(S1) = A
i01:
Next
'====================================
For Each Yk In Y.keys
If IsArray(Y(Yk)) Then
On Error Resume Next
Sheets(Val(Yk) & "").Delete
On Error GoTo 0
Sheets("¬ì¥Ø¾lÃBªí").Copy Before:=Sheets(1)
With Sheets(1)
.Name = Val(Yk)
.UsedRange.Offset(5, 0).Delete
With .[A5].Resize(Y(Yk & "|r"), 20)
.Value = Y(Yk)
Intersect([E:T], .Cells).NumberFormatLocal = _
"_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
End With
.[C3] = Y(Yk & "/c")
.[C3] = .[C3] & "¡m" & Y(Yk & "/b") & "¡n"
N = .Cells(Rows.Count, "F").End(3).Row
With .Cells(N + 1, "F").Resize(1, 15)
.Value = "=SUM(F5:F" & N & ")"
End With
End With
End If
Next
Set Y = Nothing: Erase Brr, Crr, Z, A, B
End Sub |
|