- ©«¤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
|
¦^´_ 8# ã´£³¡ªL
ÁÂÁ½׾Â,ÁÂÁ«e½ú«ü¾É
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú¦A«ü¾É
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, »Ý¨D&, Z, i&, j%, C%, T$, ®w¦s&, D As Date, W&, V&, R&
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([®w¦s!C1], [®w¦s!A65536].End(3))
For i = 2 To UBound(Brr)
T = Trim(Brr(i, 1)): If T = "" Then GoTo i01
If Not IsObject(Z(T)) Then Set Z(T) = CreateObject("Scripting.Dictionary")
Z(T)(i) = 0: Z(T & "Tot") = Z(T & "Tot") + Val(Brr(i, 3))
i01: Next
Crr = Range([ì©l!C1], [ì©l!A65536].End(3))
ReDim Arr(2 To UBound(Crr), 1 To 100)
For i = 2 To UBound(Crr)
T = Trim(Crr(i, 2)): »Ý¨D = Val(Crr(i, 3)): C = 0: If Z(T & "Tot") = 0 Then GoTo i02
For j = Z(T & "No") To Z(T).Count - 1
W = W + 1: R = Z(Trim(Crr(i, 2))).keys()(j)
®w¦s = Val(Brr(R, 3))
D = CDate(Brr(Z(Trim(Crr(i, 2))).keys()(j), 2))
V = IIf(®w¦s < »Ý¨D, ®w¦s, »Ý¨D)
Arr(i, C + 1) = D: Arr(i, C + 2) = V: C = C + 2
Z(T & "Tot") = Z(T & "Tot") - V
»Ý¨D = »Ý¨D - V: ®w¦s = ®w¦s - V
If ®w¦s = 0 Then Z(T & "No") = Z(T & "No") + 1 Else Brr(R, 3) = ®w¦s
If »Ý¨D = 0 Then Exit For
Next
i02: If Z(T & "Tot") = 0 And »Ý¨D > 0 Then Arr(i, C + 1) = "¨S¦³¸ê®Æ": Arr(i, C + 2) = "¼Æ¶q¤£¨¬"
Next
[ì©l!D2].Resize(UBound(Arr) - 1, UBound(Arr, 2)) = Arr
MsgBox "°j°é¼Æ:" & W
End Sub |
|