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

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

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

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-4-10 10:41 ½s¿è

­P ¦U¦ì«e½ú ¯à·Ð´À¤p§Ì¸Ñ´b ¡A¦bªþ¥ó¤¤ªº ÀÉ®×
¤p§ÌÁö¼g¤F¨Ç»yªk¡A¦ý¤´¥¼¯à¹F¦¨ ¡A§Ú­nªº·Qªk
¦bªþ¥ó¸Ì  ¡A

¡n¡n¥H¦hµ§ªº¸ê®Æ¸Ì ¡AjÄæ¦ì ¬°¥Ø«e  gÄæ¦ì¡]«~¶µ¡^ªº©Ò¦³®w¦s¼Æ  ¡C

1¤ñ¹ïgÄæ¦ì¡]«~¶µ¡^ ¡A¦p¤£¦P«~¶µ¡A«h¥H   hÄæ¦ì¡]­q³æ¼Æ¡^ ¡F§@¬°i Äæ¦ì¡]¥i¥X³f¼Æ¡^

2.¦ý¤ñ¹ïgÄæ¦ì¡]«~¶µ¡^¡A¦p¬°¦P«~¡A«h¥H j Äæ¦ì ªº®w¦s¬°°ò·Ç ¡A¨Ì§Ç¦©°£  ¦Ü ®w¦s¬°0 ¬°¤î¡A«áÄò¦pÁÙ¦³ ¦P«~­n¥X ¡A«hª½±µ§R°£ ¡A¤£Ä~Äò¤ñ¹ï¡C

¦ý¦b¹Lµ{¤¤¡A³o¸Ì¹J¨ì¨Çª¬ªp ¡A¦p¤W¤@µ§ ¦©§¹®w¦s¼Æ¦pÁÙ¦³ 4­Ó ¡A¤U¤@µ§  ­q³æ¬O­n  5­Ó ¡A¦ý¦b§PÂ_¤W ¡A¤´¬O±o¥X 4­Ó ¡A¦ý¤£§R°£¡A¬O§R°£«áÄòªº­q³æ¡C

        item        ­q³æ¼Æ        ¹ê»Ú¥i¥X        ®w¦s¼Æ       
        a                  4                       4                  10       
1        b                  5                       5                  10       
2        b                  5                       5                  10       
3        b                  5                       0                  10        §R¥h

³o¸Ì¥Ñ¤ßÁ¹L¦U¦ì

¦^´_ 1# melvinhsu


ªO¤j¡A¤p§Ìªþ¤W¡A ¬¡­¶Ã¯1.zip (27.79 KB)

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-4-10 19:06 ½s¿è

¦^´_ 2# melvinhsu
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub testing3()
  3.     Dim i As Integer, D1 As Object, D2 As Object, Rng As Range
  4.     Set D1 = CreateObject("SCRIPTING.DICTIONARY")  '¦r¨åª«¥ó
  5.     Set D2 = CreateObject("SCRIPTING.DICTIONARY")  '¦r¨åª«¥ó
  6.     i = 2                                          '²Ä2¦C¶}©l
  7.    
  8.     Do While Cells(i, "G") <> ""                   '°õ¦æ°j°é±ø¥ó GÄæ<>""
  9.         With Cells(i, "G")                         'GÄæi¦C ªºª«¥ó
  10.             If Not D1.Exists(.Value) Then          '¦r¨åªºkey¤£¦s¦b
  11.                 D1(.Value) = Cells(i, "J")         '®w¦s¼Æ
  12.                 D2(.Value) = 0                     '¥X³f¼ÆÁ`¼Æ
  13.             End If
  14.             If (D1(.Value) - D2(.Value)) >= Cells(i, "H") Then '®w¦s¼Æ-¥X³f¼ÆÁ`¼Æ>=­q³æ¼Æ
  15.                 Cells(i, "I") = Cells(i, "H")           '­q³æ¹ê»Ú¥X³f¼Æ
  16.                 D2(.Value) = D2(.Value) + Cells(i, "I") '­q³æ¹ê»Ú¥X³f¼Æªº¥[Á`
  17.             ElseIf (D1(.Value) - D2(.Value)) > 0 And (D1(.Value) - D2(.Value)) < Cells(i, "H") Then
  18.                  '®w¦s¼Æ-¥X³f¼ÆÁ`¼Æ > 0                 '®w¦s¼Æ-¥X³f¼ÆÁ`¼Æ > ­q³æ¼Æ
  19.                 Cells(i, "I") = D1(.Value) - D2(.Value) '­q³æ¹ê»Ú¥X³f¼Æ=®w¦s¼Æ-¥X³f¼ÆÁ`¼Æ
  20.                 D2(.Value) = D2(.Value) + Cells(i, "I") '¥X³f¼ÆÁ`¼Æ=¥X³f¼ÆÁ`¼Æ+­q³æ¹ê»Ú¥X³f¼Æ
  21.             ElseIf D1(.Value) = D2(.Value) Then         'µL³f¥i¥X:®w¦s¼Æ=¥X³f¼ÆÁ`¼Æ
  22.                 Cells(i, "I") = ""
  23.                 If Not Rng Is Nothing Then
  24.                     Set Rng = Union(Rng, Range("F" & i & ":J" & i))
  25.                 Else
  26.                     Set Rng = Range("F" & i & ":J" & i)
  27.                 End If
  28.             End If
  29.         End With
  30.         i = i + 1
  31.     Loop
  32.    If Not Rng Is Nothing Then Rng.Select
  33. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 3# GBKEE



ÁÂÁªO¤j¡A­@¤ßªº¦^À³¤p§Ìªº°ÝÃD¡A¤p§Ìªº¹D¦æ¯uªº®t¤Ó»·

TOP

¥»©«³Ì«á¥Ñ 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 : ±o²z­nÄǤH¡A²zª½­n®ð©M¡C
ªð¦^¦Cªí ¤W¤@¥DÃD