Access交流中心

北京 | 上海 | 天津 | 重庆 | 广州 | 深圳 | 珠海 | 汕头 | 佛山 | 中山 | 东莞 | 南京 | 苏州 | 无锡 | 常州 | 南通 | 扬州 | 徐州 | 杭州 | 温州 | 宁波 | 台州 | 福州 | 厦门 | 泉州 | 龙岩 | 合肥 | 芜湖 | 成都 | 遂宁 | 长沙 | 株洲 | 湘潭 | 武汉 | 南昌 | 济南 | 青岛 | 烟台 | 潍坊 | 淄博 | 济宁 | 太原 | 郑州 | 石家庄 | 保定 | 唐山 | 西安 | 大连 | 沈阳 | 长春 | 昆明 | 兰州 | 哈尔滨 | 佳木斯 | 南宁 | 桂林 | 海口 | 贵阳 | 西宁 | 乌鲁木齐 | 包头 |

请教个VBA随机函数

子煜  发表于:2020-06-20 11:03:02  
复制

比如我有一个数 600  想随机分成若干个,总和还是600.

用VBA怎样解决?

谢谢!

 

Top
Hyp 发表于:2020-06-21 17:24:31
Sub kkk()
    Dim theBalance&, i&, j&, k&, m&, theNum&, theNumTemp&
    Dim theStr$, arr As Variant, d As Object
    '
    j = 2 + Int(Rnd * 30)
    ReDim arr(1 To j, 1 To 1)
    theBalance = 600
    theNum = theBalance \ j
    For i = 1 To j
        arr(i, 1) = theNum
    Next i
    theNum = theBalance Mod j
    arr(j, 1) = arr(j, 1) + theNum
    '
    Set d = CreateObject("SCripting.Dictionary")
    Randomize
    For i = 1 To j - 1
        Do
            theNum = Int(Rnd * arr(i, 1))
            theNumTemp = arr(i, 1) - theNum
            If Not d.Exists(theNumTemp) Then
                arr(i, 1) = theNumTemp
                d(theNumTemp) = ""
                arr(i + 1, 1) = arr(i + 1, 1) + theNum
                Exit Do
            End If
        Loop
    Next i
    k = j
    i = 0
    Do While d.Exists(arr(k, 1))
        theNum = Int(Rnd * arr(k, 1))
        theNumTemp = arr(k, 1) - theNum
        If Not d.Exists(theNumTemp) Then
            arr(k, 1) = theNumTemp
            d(theNumTemp) = ""
            For m = 1 To k - 1
                theNumTemp = arr(m, 1) + theNum
                If Not d.Exists(theNumTemp) Then
                    arr(m, 1) = theNumTemp
                    Exit Do
                End If
            Next m
            '
            For m = k + 1 To j
                theNumTemp = arr(m, 1) + theNum
                If Not d.Exists(theNumTemp) Then
                    arr(m, 1) = theNumTemp
                    Exit Do
                End If
            Next m
        End If
        i = i + 1
        If i = 5000 Then Exit Do
    Loop
    '
    theStr = arr(1, 1)
    For i = 2 To j
        theStr = theStr & " " & arr(i, 1)
    Next i
    MsgBox "拆分成 " & j & " 个数字:" & vbLf & vbLf & theStr
    Set d = Nothing
End Sub
你没有说明是否允许生成的若干个数存在重复。

子煜 发表于:2020-06-22 08:58:30
大神,厉害!!!

总记录:2篇  页次:1/1 9 1 :