Andy2483

¦^´_ 1# dou10801


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò,¥H¤U¬O¾Ç²ß¤è®×,½Ð«e½ú°Ñ¦Ò

°õ¦æµ²ªG:

¤U¸ü (156.77 KB)

2025-9-23 14:49

Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 1000), Drr(1 To 1000), D, i&, M%, N%, xR As Range, Ra As Range
Set Brr = Range([H2], [B65536].End(3)(1, 3))
For i = 1 To Brr.Rows.Count
   M = Brr(i, 2).MergeArea.Count
   N = N + 1
   Crr(N) = M
   i = i + M - 1
Next
Set xR = Brr(1)
For i = 1 To N
   For Each Ra In xR.Resize(Crr(i), Brr.Columns.Count)
      Drr(i) = Drr(i) + (Val(Ra.MergeArea(1)) / Ra.MergeArea.Count)
   Next
   If Drr(i) <> 0 Then xR(1, 8) = Drr(i)
   xR(1, 8).Resize(Crr(i)).Merge
   Set xR = xR(Crr(i) + 1)
Next
xR(1, 8) = "=SUM($K$2:K" & Brr.Rows.Count + 1 & ")"
End Sub

Andy2483

¦^´_ 3# Andy2483


    ¥H¤U¬O¤µ¤Ñ½m²ß ¬Q¤Ñª©¥»¦A²¤Æªº¤è®×,½Ð«e½ú­Ì«ü±Ð
Option Explicit
Sub TEST_1()
Dim Brr As Range, xR As Range, Ra As Range, i&, M%
[K:K].Clear
Set Brr = Range([H2], [B65536].End(3)(1, 3))
Set xR = Brr(1)
For i = 1 To Brr.Rows.Count
   M = Brr(i, 2).MergeArea.Count
   For Each Ra In xR.Resize(M, Brr.Columns.Count)
      xR(1, 8) = xR(1, 8) + (Val(Ra.MergeArea(1)) / Ra.MergeArea.Count)
   Next
   If xR(1, 8) = 0 Then xR(1, 8) = ""
   If M > 1 Then xR(1, 8).Resize(M).Merge
   Set xR = xR(M + 1)
   i = i + M - 1
Next
xR(1, 8) = "=SUM($K$2:K" & Brr.Rows.Count + 1 & ")"
End Sub