- ©«¤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-11-13 16:05 ½s¿è
¦^´_ 30# ã´£³¡ªL
ÁÂÁ½׾Â,ÁÂÁ«e½ú«ü¾É
«á¾Ç¾Ç²ß«e½úªº¤è®×,¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É
Sub ¬y¤ô½s¸¹1()
Dim Arr, i&, V&, N&, Y&, T1$, T2$, TT$, P%, x%, SS(2)
'¡ô«Å§iÅܼÆ:Arr¬O³q¥Î«¬ÅܼÆ,(i,V,N,Y)¬Oªø¾ã¼ÆÅܼÆ,(T1,T2,TT)¬O¦r¦êÅܼÆ,
'(P,x)¬Oµu¾ã¼ÆÅܼÆ,SS¬O¤@ºû°}¦C(¯Á¤Þ¸¹0~2)
Arr = Range([c1], [b65536].End(xlUp)(1, 0))
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO¤Gºû°}¦C,¥H[C1]¨ì BÄæ³Ì«á¦³¤º®eÀx¦s®æ¥ª°¼®æ(AÄæ),
'¥H³o½d³òÀx¦s®æȱa¤J°}¦C¤¤
For i = 3 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q3¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
If Arr(i, 1) = "¦Xp" Then Exit For
'¡ô¦pªGi°j°é¦C²Ä1ÄæArr°}¦CȬO "¦Xp"? True´Nµ²§ô°j°é°õ¦æ
N = N + 1: Arr(i - 2, 1) = ""
'¡ô¥ON³oªø¾ã¼ÆÅܼƲ֥[ 1
'¥O(i°j°é-1)¦C²Ä1ÄæArr°}¦CȬO ªÅ¦r¤¸
P = Val(Arr(i, 2)): V = Val(Arr(i, 3))
'¡ô¥OP³oµu¾ã¼Æ¬Oi°j°é¦C²Ä2ÄæArr°}¦CÈ
'¥OV³oªø¾ã¼Æ¬Oi°j°é¦C²Ä3ÄæArr°}¦CÈ
x = Switch(P = 100, 1, P = 200, 2, P = 500, 2, P = P, 0)
'¡ô¥Ox³oµu¾ã¼Æ¬OSwitch()¨ç¦¡¦^¶ÇÈ
https://learn.microsoft.com/zh-t ... elp/switch-function
If P = 0 Or V = 0 Or x = 0 Then GoTo i01
'¡ô¦pªGPÅܼƬO0 ©ÎV¬O0 ¤S©Îx¬O0,¨ä¤¤¤@±ø¥ó¦¨¥ß!´N¸õ¨ì ¼Ð¥Üi01ªº¦ì¸mÄ~Äò°õ¦æ
Y = Array(64564, 81140)(x - 1): TT = Array("A", "B")(x - 1)
'¡ô¥OY³oªø¾ã¼ÆÅܼƬO ¤@ºû°}¦Cªº¯Á¤Þ¸¹(xÅܼÆ-1)°}¦CÈ
'¥OTT³o¦r¦êÅܼÆÅܼƬO ¤@ºû°}¦Cªº¯Á¤Þ¸¹(xÅܼÆ-1)°}¦CÈ
T1 = TT & Format(Y + SS(x) + 1, "0000000")
'¡ô¥OT1ÅܼƬO TTÅܼƳs±µ (YÅܼÆ+x¯Á¤Þ¸¹SS°}¦CȦA+1)Âন7½X¼ÆÈ,©Ò²Õ¦¨ªº·s¦r¦ê
T2 = TT & Format(Y + SS(x) + V, "0000000")
'¡ô¥OT2ÅܼƬO TTÅܼƳs±µ (YÅܼÆ+x¯Á¤Þ¸¹SS°}¦CȦA+VÅܼÆ)Âন7½X¼ÆÈ,©Ò²Õ¦¨ªº·s¦r¦ê
Arr(i - 2, 1) = T1 & IIf(T1 = T2, "", "-" & T2)
'¡ô¥O(i°j°é-2)¦C²Ä1ÄæArr°}¦CȬO T1ÅܼƳs±µ ªÅ¦r¤¸©Î ("-"³s±µT2ÅܼƲզ¨¦r¦ê)
'IIf():¦pªGT1ÅܼƦPT2ÅܼÆ(§Y±i¼Æ¬O1±i)!´N¦^¶Ç ªÅ¦r¤¸,§_«h¦^¶Ç¦r¦ê
SS(x) = SS(x) + V
'¡ô¥OxÅܼƯÁ¤Þ¸¹SS°}¦CȬO ²Ö¥[VÅܼƪº¼ÆÈ
i01: Next i
[d3].Resize(N) = Arr
'¡ô¥O[D3]ÂX®i¦V¤U NÅܼƦCÀx¦s®æÈ ¥HArr°}¦Cȱa¤J
End Sub
'============================================================
Option Explicit
Sub TEST()
Dim Brr, E, P, Q&, i&, H&, c, K%, S&(1), T$, Ts$, Te$
c = Application.Match("¦Xp", [A:A], 0)
If IsError(c) Then Exit Sub
Brr = [B3].Resize(c - 3, 3)
E = Array(64564, 81140): P = Array("A", "B")
For i = 1 To UBound(Brr)
Q = Val(Brr(i, 1)): H = Val(Brr(i, 2))
K = Switch(Q = 100, 0, InStr("200/500", Q), 1, Q = Q, -1)
T = P(K) & "0000000": Brr(i, 1) = ""
If (Q = 0) + (H = 0) + (K = -1) < 0 Then GoTo i01
S(K) = E(K) + 1: E(K) = E(K) + H
Ts = Format(S(K), T): Te = Format(E(K), T)
Brr(i, 1) = Ts & IIf(S(K) = E(K), "", "-" & Te)
S(K) = E(K)
i01: Next
[I3].Resize(UBound(Brr)) = Brr
End Sub |
|