Andy2483

¦^´_ 2# hcm19522


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
·s¼W_20230923.zip (18.15 KB)

¤U¸ü¦¸¼Æ: 2

2023-9-23 14:16

°õ¦æ«e:

¤U¸ü (97.98 KB)

2023-9-23 14:16

°õ¦æµ²ªG:

¤U¸ü (102.18 KB)

2023-9-23 14:16

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