excel 修改此子随机数生成器子以排除某些数字

qyzbxkaa  于 2023-01-27  发布在  其他
关注(0)|答案(1)|浏览(184)

我是Excel VBA的新手。我正在做的项目处理随机数的范围。我有五个范围,发现这段代码非常好用,不会在一个范围内得到任何重复的数字:

Public Sub generateRandNum()
    'Define your variabiles
    lowerbound = 1
    upperbound = 20000
    Set randomrange = Range("A1:C5000")
    
    randomrange.Clear
    For Each rng1 In randomrange
        counter = counter + 1
    Next
    
    If counter > upperbound - lowerbound + 1 Then
        MsgBox ("Number of cells > number of unique random numbers")
        Exit Sub
    End If
    
    For Each Rng In randomrange
        randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
        Do While Application.WorksheetFunction.CountIf(randomrange, randnum) >= 1
            randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
        Loop
        Rng.Value = randnum
    Next
End Sub

项目的下一部分涉及从第二组中排除一个数字(非随机),从第四组中排除两个数字(也非随机)。
我已经搜索了整个谷歌,看了一些论坛,但要么代码看起来真的很长,要么我不能完全理解它,足以修改它为我的需要。
它必须是在VBA中,因为数字生成器的工作关闭一个按钮单击。

dgsult0t

dgsult0t1#

可以使用Dictionary对象为每一列存储“禁用”数字

Option Explicit

Public Sub generateRandNum()
    'Define your variabiles
    Dim lowerbound  As Long, _
        upperbound  As Long
    lowerbound = 1
    upperbound = 20 '20000
    
    
    'define forbidden numbers for each single column
    Dim forbiddenNumbersDict As Object
        Set forbiddenNumbersDict = CreateObject("Scripting.Dictionary")
            With forbiddenNumbersDict
                .Add 2, Array(1, 4, 9) ' column 2 forbidden numbers
                .Add 3, Array(2, 5, 7) ' column 3 forbidden numbers
                '....
            End With
    
    Dim randomrange As Range
    Set randomrange = Range("A1:C5")
    randomrange.Clear
    
    Dim counter As Long
        counter = randomrange.Count
    
    If counter > upperbound - lowerbound + 1 Then
        MsgBox ("Number of cells > number of unique random numbers")
        Exit Sub
    End If
    
    Dim rng As Range
    For Each rng In randomrange
    
        Dim rngColIndex As Long
            rngColIndex = rng.Column ' locate the current column
            
        Dim randnum As Long
        randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
            Do While Application.WorksheetFunction.CountIf(randomrange, randnum) >= 1 _
                     Or Not IsError(Application.Match(randnum, forbiddenNumbersDict(rngColIndex), 0)) ' added the condition to exclude forbidden numbers for the current column
                randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
            Loop
                rng.Value = randnum
    Next
End Sub

顺便说一句,你的算法效率很低

相关问题