ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] «e½úÃö©ó¼Æ¦C´î¥hªº¼gªk

¥»©«³Ì«á¥Ñ 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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¥¬¬I¦p¼½ºØ¡A¥HÅw³ß¤ß´þ¼íºØ¤l¡A¤~·|µoªÞ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD