- ©«¤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-27 10:11 ½s¿è
¦^´_ 24# shuo1125
ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«µo²{³o¦r¨å¬OÓ¸U¯àªºÅܼƲ£¥Í¾¹
1.¦]¬°ÅܼƤ£·|«½Æ,©Ò¥Hkey¥i¥HÂo«½Æ
2.¦]¬°key¹ïÀ³¤@Óitem(¼Æ¦r.¦r¦ê.Àx¦s®æ.°}¦C....),©Ò¥Hkey¥i·í¦¨¬O¤@ÓÅܼÆ
Option Explicit
Sub ¸ê®Æ°Ï¾lÃB_1()
Dim Y, Arr, T16&, T17&, T18&, i&, S&, T$, T2$, T3$, T20$, xR As Range
'¡ô«Å§iÅܼÆ:(Y,Arr)¬O³q¥Î«¬ÅܼÆ,(T16,T17,T18,i)¬Oªø¾ã¼Æ,
'(T,T2,T3,T20)¬O¦r¦êÅܼÆ,xR¬OÀx¦s®æÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Set xR = Range([¸ê®Æ°Ï!T2], [¸ê®Æ°Ï!A1].Cells(Rows.Count, 1).End(3))
'¡ô¥OxR³oÀx¦s®æÅܼƬO ¸ê®Æ°Ï[T2]¨ì AÄæ³Ì«á¦³¤º®eÀx¦s®æ½d³òÀx¦s®æ
Arr = xR
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥H xRÀx¦s®æȱa¤J
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q1¨ì Arr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
T2 = Arr(i, 2): T3 = Arr(i, 3): T16 = Arr(i, 16)
T17 = Arr(i, 17): T18 = Arr(i, 18): T20 = Arr(i, 20)
'¡ô¥OT2³o¦r¦êÅܼƬO i°j°é¦C²Ä2ÄæArr°}¦CÈ,¨Ì¦¹Ãþ±À
T18 = Abs(T16 - T17)
'¡ô¥OT18³oªø¾ã¼ÆÅܼƬO T16ÅÜ¼Æ - T17Åܼƫ᪺µ´¹ïȼÆÈ
T = T2 & "|" & T3
'¡ô¥OT³o¦r¦êÅܼƬO T2ÅܼƳs±µ T3ÅܼƲզ¨ªº·s¦r¦ê
If Y(T) = "" And T20 = "¨R±b" Then MsgBox "ÄY«¿ù»~": Exit Sub
'¡ô¦pªG¤@¶}©l´N¬O¨R±b!¬OÄY«¿ù»~±o¸ê®Æ
If T20 = "¥ß±b" Then
'¡ô¦pªG T20ÅܼƬO "¥ß±b" ?
Y(T) = Y(T) + T18
'¡ô¥OTÅܼƦbY¦r¨åitemȲ֥[ T18ÅܼÆ
ElseIf T20 = "¨R±b" Then
'¡ô§_«h¦pªG T20ÅܼƬO "¨R±b" ?
Y(T) = Y(T) - T18
'¡ô¥OTÅܼƦbY¦r¨åitemȲ֦© T18ÅܼÆ
Else
MsgBox "µLªk¿ëÃÑ": Application.Goto xR(i, 20): Exit Sub
'¡ô§_«h´N¸õ¥X´£¥Üµ¡,Àx¦s®æ´å¼Ð¸õ¨ìRÄæi°j°é¦C¦ì¸m:µ²§ôµ{¦¡
End If
Arr(i, 18) = Y(T)
'¡ô¥Oi°j°é¦C²Ä18ÄæArr°}¦CȬOTÅܼƬdY¦r¨åªºitemÈ
Next
[A2].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
'¡ô¥O[A2]ÂX®i¦V¤UArrÁa¦V³Ì¤j¯Á¤Þ¦C¸¹¼Æ,ÂX®i¦V¥k³Ì¤j¯Á¤ÞÄ渹¼Æ,
'³oÂX®i½d³òÀx¦s®æÈ¥HArr°}¦Cȱa¤J
Erase Arr: Set xR = Nothing: Set Y = Nothing
'¡ô¥OÄÀ©ñÅܼÆ
End Sub |
|