- ©«¤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
|
¦^´_ 2# hcm19522
ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
·s¼W_20230923.zip (18.15 KB)
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Z, Q, R&, i&, j%, T$, ¶O¥Î¶µ%
If [E2] <> "" Then Range([E2], [E65536].End(3)).ClearContents: Exit Sub
Range([E2], [E65536].End(3)(2)).ClearContents
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([N1], [K65536].End(3))
Crr = Range([E1], [A65536].End(3)): R = UBound(Crr)
ReDim Arr(1 To R, 1 To 10)
For i = 2 To UBound(Brr)
If Z(Brr(i, 2)) = "" Then ¶O¥Î¶µ = ¶O¥Î¶µ + 1: Z(Brr(i, 2)) = 0: Arr(1, ¶O¥Î¶µ) = Brr(i, 2)
T = Brr(i, 1) & "|" & Brr(i, 2)
Z(T) = Brr(i, 3)
For Each Q In Split(Brr(i, 4), ",")
If Q <> "" Then Z(T & "|" & Q) = Brr(i, 3)
Next
Next
For i = 2 To R
For j = 1 To ¶O¥Î¶µ
T = Crr(i, 1) & "|" & Arr(1, j)
Arr(i, j) = Z(T) - Z(T & "|" & Crr(i, 2))
If Arr(i, j) <> 0 Then Z(T & "/t") = Z(T & "/t") + Crr(i, 4)
Next
Next
For i = 2 To R
For j = 1 To ¶O¥Î¶µ
T = Crr(i, 1) & "|" & Arr(1, j)
If Z(T & "/t") > 0 Then Crr(i - 1, 1) = Val(Crr(i - 1, 1)) + Arr(i, j) * (Crr(i, 4) / Z(T & "/t"))
Next
Next
[E2].Resize(R - 1, 1) = Crr
Set Z = Nothing: Erase Arr, Brr, Crr
End Sub |
|