生成相同的随机数最大6倍vba

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

（编辑）的

我目前的代码是写我计算行的值除以6以确定我需要多less不同的随机数。 如果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

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

 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行，因此请注意是否大于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