- ©«¤l
 - 1527 
 - ¥DÃD
 - 40 
 - ºëµØ
 - 0 
 - ¿n¤À
 - 1551 
 - ÂI¦W
 - 0  
 - §@·~¨t²Î
 - Windows  7 
 - ³nÅ骩¥»
 - Excel 2010 & 2016 
 - ¾\ŪÅv
 - 100 
 - ©Ê§O
 - ¨k 
 - ¨Ó¦Û
 - ¥xÆW 
 - µù¥U®É¶¡
 - 2020-7-15 
 - ³Ì«áµn¿ý
 - 2025-11-4 
 
  | 
                
¦^´_ 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 |   
 
 
 
 |