VBA在整个范围内动态分布值

我试图在以前的工作的基础上，根据排名来分配价值。下面的代码可以工作，但假设总是有三行要排序

示例图像和代码

子发行版（）
设置R1=ActiveSheet.UsedRange
M=62
对于i=2至UBound（T1）
如果T1（i，2）>0，那么
V=T1（i，2）
如果V M那么
B=M
V=V-M
如果V>M那么
C=M
其他的
C=V
如果结束
其他的
B=V
C=0
如果结束
对于j=i到i+2
选择案例T1（j，1）
情况是=1
T1（j，3）=A
情况是=2
T1（j，3）=B
情况是=3
T1（j，3）=C
结束选择
下一个j
如果结束
如果结束
接下来我
对于i=2至UBound（T1）
单元（i，3）=T1（i，3）
接下来我
端接头

理想结果：我需要一种方法使分布动态响应行高或

循环

值

逻辑应确定范围有多宽（即

循环

值），并根据等级在范围内分配值，每个单元格的最大值不超过62。见下图

非常感谢您的帮助，并很高兴提供澄清

---

如果D列中的循环值已经存在，我认为这将起作用

Sub x()

Dim r As Range, rDist As Range, n As Variant, i As Long, wf As WorksheetFunction

Const nMax As Long = 62
Set wf = WorksheetFunction

For Each r In Range("D2", Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
    Set rDist = r.Offset(, -3).Resize(r.Value, 3)
    For i = 1 To r
        n = Application.Match(i, rDist.Columns(1), 0)
        If IsNumeric(n) Then
            If wf.Max(rDist.Columns(2)) - wf.Sum(rDist.Columns(3)) < nMax Then
                rDist(n, 3) = wf.Max(rDist.Columns(2)) - wf.Sum(rDist.Columns(3))
                Exit For
            Else
                rDist(n, 3) = nMax
            End If
        End If
    Next i
Next r

Columns(3).SpecialCells(xlCellTypeBlanks).Value = 0

End Sub

subx（）
Dim r作为范围，rDist作为范围，n作为变量，i作为长度，wf作为工作表功能
常数nMax，长度=62
设置wf=工作表功能
对于范围（“D2”、范围（“D”和Rows.Count）中的每个r.End（xlUp））.SpecialCells（xlCellTypeConstants）
设置rDist=r.Offset（，-3）。调整大小（r.Value，3）
对于i=1到r
n=Application.Match（i，rDist.Columns（1），0）
如果是数字（n），则
如果wf.Max（rDist.Columns（2））-wf.Sum（rDist.Columns（3））

非常感谢@SJR。你能解释一下最里面的IF语句的细节吗？我收集了一些逻辑，但想了解背后的想法。我很高兴。内部循环计算“值”列中的总和与“分布”列中迄今为止的值之和之间的差值。如果差值小于62，则将整个金额放入相关单元格并退出循环；否则，它会将62添加到相关单元格并继续下一个列。清楚的

Sub x()

Dim r As Range, rDist As Range, n As Variant, i As Long, wf As WorksheetFunction

Const nMax As Long = 62
Set wf = WorksheetFunction

For Each r In Range("D2", Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
    Set rDist = r.Offset(, -3).Resize(r.Value, 3)
    For i = 1 To r
        n = Application.Match(i, rDist.Columns(1), 0)
        If IsNumeric(n) Then
            If wf.Max(rDist.Columns(2)) - wf.Sum(rDist.Columns(3)) < nMax Then
                rDist(n, 3) = wf.Max(rDist.Columns(2)) - wf.Sum(rDist.Columns(3))
                Exit For
            Else
                rDist(n, 3) = nMax
            End If
        End If
    Next i
Next r

Columns(3).SpecialCells(xlCellTypeBlanks).Value = 0

End Sub