按比例分配数据这种题，看着简单做着难

糖↗小冷

需要E列“优良中次差”的等级评价，按红色部分“预设比例数”进行重新分配， 重新分配后复核区计算出来的数值与预设区的数值相差不大即可，无需十分精确

liulang0808

这样的需求案例，论坛里能找到的，之前也解答过吧
不过楼主规划的比例根前面数据的重复度 有关系。如果重复度很低，那么容易按照比例计算结果
如果重复数据太多会很麻烦的。
极端举例，如果仅有100跟90，怎么按照比列分，相同分数怎么处理？

3190496160

Sub 等级()
With Sheet1
    rr = .Range("g1:h6")
    r = .Cells(Rows.Count, 3).End(xlUp).Row
    ar = .Range("c1:c" & r)
    ReDim br(1 To UBound(ar), 1 To 1)
    br(1, 1) = "等级"
    sl = r - 1
    For s = 2 To UBound(rr) '- 1
        If Trim(rr(s, 1)) <> "" Then
            If s = 2 Then
                mc = Round(rr(s, 2) * sl, 0)
            Else
                mc = mc + Round(rr(s, 2) * sl, 0)
            End If
            zdz = Application.Large(.Range("c2:c" & r), mc)
            For i = 2 To UBound(ar)
                If ar(i, 1) >= zdz Then
                    If br(i, 1) = "" Then br(i, 1) = rr(s, 1)
                End If
            Next i
        End If
    Next s
    For i = 2 To UBound(ar)
        If br(i, 1) = "" Then
            br(i, 1) = rr(UBound(rr), 1)
        End If
    Next i
    .[e1].Resize(UBound(ar), 1) = br
End With
End Sub

3190496160

仅供参考
附件.rar (22.97 KB, 下载次数: 4)

2022-12-9 13:44 上传

点击文件名下载附件

grf1973

干得漂亮。

grf1973

有个小缺点就是前几个级别比例都会略小于设定比例，误到最后一个级别来调整。

grf1973

完善了一下。上一版结果不够随机。
代码不够简洁，里面的逻辑关系还可以好好整一下，但这样写清楚一点

sdytsxd991122

grf1973 发表于 2022-12-9 15:10
完善了一下。上一版结果不够随机。
代码不够简洁，里面的逻辑关系还可以好好整一下，但这样写清楚一点

思路严谨，学习了