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

¸É§Uª÷ÃB­pºâ¡A¨ç¼Æ­pºâ°ÝÃD

¸É§Uª÷ÃB­pºâ¡A¨ç¼Æ­pºâ°ÝÃD

½Ð°Ý¤j¯«¡A¦]¬°­n­pºâ¤½¥q®È¹C¸É§Uª÷ÃB¬O§_¦b¹wºâ¤º
¶À©³­pºâ¶O¥Î¤½¦¡¦]¬°»Ý¦Ò¼{²Ä´X¦ì¸ò¦~ÄÖ¡A¦Û¶Oª÷ÃB¤£¦P
¥ÎIF¼g¤F«Ü¦h¼h¡A¦ý­×§ï¤H¼Æ®É³£¦³¾÷²v­pºâ¿ù»~¡AÅÞ¿è¤Ó®t
ÁٽФj¯«­Ì´£ÂI´£ÂI ÁÂÁÂ

2023§À¤úª÷ÃB¸Õºâask.rar (18.83 KB)

C2=LOOKUP(B2,{0,1,2,3},SUBTOTAL(9,OFFSET(Q$3,,,,{1,2,3,4}))-Q$3)
google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

¦^´_ 1# abc9gad2016


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ßVBA,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
2023§À¤úª÷ÃB¸Õºâask.rar (18.83 KB)

°õ¦æ«e:


°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr, Crr, Q, i&, j%, ¦û§É, y6_11, y3_5, y0_2, N%, N1%, ­ì»ù&, ¦Û¶O&, xA, xB
Set ¦û§É = [N3]: Set y6_11 = [N4]: Set y3_5 = [N5]: Set y0_2 = [N6]
Set xA = Range([I2], [A65536].End(xlUp)): Brr = xA: Set xB = [J2].Resize(UBound(Brr), 3)
If [C3] <> "" Then Intersect(xA, [C:C,E:E,G:G,I:L]).ClearContents: xB.ClearContents: Exit Sub
Intersect(xA, [C:C,E:E,G:G,I:L]).ClearContents: xB.ClearContents: Crr = xB
For i = 1 To UBound(Brr)
   For j = 3 To 9 Step 2: Brr(i, j) = 0: Next
   N = N + 1: Q = Val(Brr(i, 2)): ­ì»ù = ¦û§É
   For j = 1 To Q
      Brr(i, 3) = Brr(i, 3) + ¦û§É(1, j + 1)
      ­ì»ù = ­ì»ù + ¦û§É
   Next
   ¦Û¶O = ¦Û¶O + Brr(i, 3)
   If Q > 0 Then N = N + 1
   If Val(Brr(i, 4)) = 0 Then
      Brr(i, 5) = 0
      Else
      For j = 2 To Val(Brr(i, 4)) + 1:
         Brr(i, 5) = Brr(i, 5) + y6_11(1, j - (Q > 0)): ­ì»ù = ­ì»ù + y6_11
      Next
   End If
   ¦Û¶O = ¦Û¶O + Brr(i, 5)
   If Brr(i, 4) > 0 And Q <= 1 Then N = N + 1
   If Val(Brr(i, 6)) = 0 Then
      Brr(i, 7) = 0
      Else
      For j = N To Val(Brr(i, 6)) + N - 1
         Brr(i, 7) = Brr(i, 7) + y3_5(1, j + 1): ­ì»ù = ­ì»ù + y3_5
      Next
   End If
   ¦Û¶O = ¦Û¶O + Brr(i, 7)
   If Brr(i, 6) > 0 And Q <= 1 Then N = N + 1
   If Val(Brr(i, 8)) = 0 Then
      Brr(i, 9) = 0
      Else
      For j = N To Val(Brr(i, 8)) + N - 1
         Brr(i, 9) = Brr(i, 9) + y0_2(1, j + 1): ­ì»ù = ­ì»ù + y0_2
      Next
   End If
   ¦Û¶O = ¦Û¶O + Brr(i, 9)
   Crr(i, 1) = ­ì»ù: Crr(i, 2) = ¦Û¶O: Crr(i, 3) = ­ì»ù - ¦Û¶O
   N = 0: Q = 0: ­ì»ù = 0: ¦Û¶O = 0
Next
xA.Value = Brr
xB.Value = Crr
Erase Brr, Crr
Set ¦û§É = Nothing: Set y6_11 = Nothing: Set y3_5 = Nothing: Set y0_2 = Nothing
Set xA = Nothing: Set xB = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ª¾ÃÑ­n¥Î¤ßÅé·|¡A¤~¯àÅܦ¨¦Û¤vªº´¼¼z¡C
ªð¦^¦Cªí ¤W¤@¥DÃD