- ©«¤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-4-18 14:28 ½s¿è
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,Åܧ󱡹Ҭ°¼ÒÀÀ¥X³fµ²¾l©Î¤£¨¬,
¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Brr, Y, Lh&, Lj&, i&, Tg$, xR As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([J1], Cells(Rows.Count, "G").End(xlUp)): Brr = xR
For i = 2 To UBound(Brr)
If i = 2 Then Brr(1, 1) = "q³æ¶q²Ö¥[": Brr(1, 2) = "µêÀÀ¥X³f«á®w¦s": Brr(1, 3) = "³Æµù"
Tg = Brr(i, 1): Lh = Brr(i, 2): Lj = Brr(i, 4)
If Y(Tg) = "" Then
Y(Tg) = Lh: Y(Tg & "®w¦s") = Lj
Else: Y(Tg) = Y(Tg) + Lh
End If
Y(Tg & "®w¦s") = Y(Tg & "®w¦s") - Lh
Brr(i, 1) = Y(Tg)
Brr(i, 2) = Y(Tg & "®w¦s")
If Brr(i, 2) < 0 Then
Brr(i, 3) = Tg & "_®w¦s¼Æ¤£¨¬²Öp " & -Brr(i, 2)
ElseIf Brr(i, 2) = 0 Then Brr(i, 3) = Tg & "_0®w¦s"
Else: Brr(i, 3) = Tg & "_®w¦s¼Æµ²¾l " & Brr(i, 2)
End If
Next
With Intersect(xR.Offset(0, 4), [K:M])
.EntireColumn.ClearContents
.Value = Brr
End With
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub |
|