救助用VBA 在一个工作薄中随机生成1到12个月工资表（用于随机发放奖励）

额发二夫人

救助用VBA 在一个工作薄中随机生成1到12个月工资表，已一月为例职工290人，工资总额为12万，要求没人的工资在300-600元之间，并且大于500元占总人数的20%以上，（用于随机发放奖励）

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    ActiveSheet.UsedRange.Offset(2, 2).ClearContents
    arr = [a1].CurrentRegion
    mn = 300
    mx = 600
    sm = 120000
    For j = 3 To UBound(arr)
        arr(j, 3) = mn
        sm = sm - mn
        d(j) = j
    Next j
    [a1].CurrentRegion = arr
    For j = 1 To (UBound(arr) - 1) * 0.2 + 0.5
        x = WorksheetFunction.RandBetween(201, WorksheetFunction.Min(sm, 300))
        y = WorksheetFunction.RandBetween(0, d.Count - 1)
        k = d.keys()(y)
        arr(k, 3) = arr(k, 3) + x
        d.Remove k
        sm = sm - x
    Next j
    [a1].CurrentRegion = arr
l1:
    For j = 3 To UBound(arr)
        If sm = 0 Then Exit For
        If arr(j, 3) < 600 Then
            x = WorksheetFunction.RandBetween(1, WorksheetFunction.Min(50, sm, 600 - arr(j, 3)))
            arr(j, 3) = arr(j, 3) + x
            sm = sm - x
        End If
    Next j
    If sm > 0 Then GoTo l1
    [a1].CurrentRegion = arr
End Sub

liulang0808

工资.zip (27.39 KB, 下载次数: 12)

2024-1-8 16:59 上传

点击文件名下载附件

山菊花

供参考。

gwjkkkkk

参与一下。。。