Question

我的问题是我试图在1-10之间做一系列随机数字，这些数字将分散在50个帖子上，相同的随机数最多只能出现6次。

（已编辑）

我的当前代码是写入的，我计算值为6的行，以确定我需要多少个不同的随机数。如果58个细胞有价值，我需要1-10之间的随机数。我认为我需要的最大行数为200

Dim i As Integer
Dim a As Integer

a1 = ActiveSheet.UsedRange.Rows.Count

Range("E1") = a1

For i = 1 To a1
MinNumber = 1
MaxNumber = a1 / 6
Range("D1") = MaxNumber

Cells(i, 1).Value = Int((Rnd * (MaxNumber - MinNumber + 1)) + MinNumber)
Next i

Answer 1

此代码使用词典输入所需数字的初始范围，然后逐个删除它们。

Sub Recut()

Dim a As Long

Dim objDic As Object
Dim lngCnt As Long
Dim lngCnt2 As Long
Dim lngCnt3 As Long

Dim lngTot As Long
Dim lngOut As Long
Dim lngNum As Long

lngTot = Application.InputBox("Input number of items to generate", , ActiveSheet.UsedRange.Rows.Count)

Set objDic = CreateObject("scripting.dictionary")
MinNumber = 1
MaxNumber = Int(lngTot / 6) + 1

For lngCnt = 1 To 6
    For lngCnt2 = 1 To MaxNumber
        lngCnt3 = lngCnt3 + 1
        objDic.Add lngCnt2 & "|" & lngCnt, lngCnt3
    Next
Next

For lngOut = 1 To a
    lngNum = Int(Rnd() * objDic.Count)
    Cells(lngOut, 1) = Application.Index(Split(objDic.Keys(lngNum), "|"), 1)
    objDic.Remove objDic.Keys(lngNum)
Next
End Sub

Answer 2

以下是将使用数组的代码版本，请注意，您说最多200行，因此请注意＆gt; 200.如果相同的数字产生超过6次，那么将找到一个替代。如果烦人的话，你可以删除Debug.Print。

Option Explicit

Sub Random_Numbers()

Dim i           As Integer
Dim a           As Integer
Dim lLastRow    As Long
Dim MinNumber   As Long
Dim MaxNumber   As Long
Dim lRndNbr     As Long
Dim aLimitTo6(200) As Integer

    lLastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Range("E1") = lLastRow

    If lLastRow > 200 Then
        MsgBox "You are generating numbers for more than 200 rows!! Either increase the Array, or go to 'Plan B'"
        Exit Sub
    End If

    MinNumber = 1
    MaxNumber = lLastRow / 6
    Range("D1") = MaxNumber

    For i = 1 To lLastRow
        lRndNbr = Int((Rnd * (MaxNumber - MinNumber + 1)) + MinNumber)
        aLimitTo6(lRndNbr) = aLimitTo6(lRndNbr) + 1
        If aLimitTo6(lRndNbr) > 6 Then
            Debug.Print lRndNbr & " already generated six times!!"
            Do      ' Try forever?
                lRndNbr = Int((Rnd * (MaxNumber - MinNumber + 1)) + MinNumber)
                aLimitTo6(lRndNbr) = aLimitTo6(lRndNbr) + 1
                If aLimitTo6(lRndNbr) > 6 Then
                    Debug.Print "Tried once to get another random number (" & lRndNbr & "), but failed!! What do you want to do?"
                Else
                    Cells(i, 1).value = lRndNbr
                    Exit Do
                End If
            Loop
        Else
            Cells(i, 1).value = lRndNbr
        End If
    Next i
End Sub

生成相同的随机数最多6次vba

2 个答案: