VBA随机数字生成器 - 可能更有效率?

时间:2017-10-23 11:30:39

标签: vba random

我有一个随机数生成代码,如下所示。它从预定义的人口范围生成“x”数量的数字。生成它们需要一些时间,如果效率更高,我就会徘徊?数字不能重复。

Private Sub CommandButton1_Click()

Dim real_rnd As Double
Dim letter_lng As Long
Dim lngCounter As Long
Dim lngRandomFigureList(2000) As Long
Dim i As Integer
Dim lngPopulation As Long
Dim intNoOfSamples As Integer
Dim strCell As String
Dim blnDuplicate As Boolean
Dim blnFound As Boolean


Sheets("random selection").Select
Range("Pop").Select
lngPopulation = ActiveCell.Value

Range("NoSamp").Select
intNoOfSamples = ActiveCell.Value

Range("Figures").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("Figures").Select

Range("Figures").Select

For lngCounter = 1 To intNoOfSamples
    blnDuplicate = True
    Do While blnDuplicate = True
        real_rnd = Rnd() * (lngPopulation - 1) + 1
        letter_lng = Abs(real_rnd)
        blnFound = False
        For i = 1 To lngCounter - 1
            If letter_lng = lngRandomFigureList(i) Then
                blnFound = True
            End If
        Next i
        If blnFound = False Then
            blnDuplicate = False
        End If
    Loop

    lngRandomFigureList(lngCounter) = letter_lng
    strCell = "A" & 6 + lngCounter
    Range(strCell).Select
    ActiveCell.Value = letter_lng
Next lngCounter`

1 个答案:

答案 0 :(得分:0)

摆脱选择:

With Sheets("random selection")
    lngPopulation = .Range("Pop").Value
    intNoOfSamples = .Range("NoSamp").Value
    Range(.Range("Figures"), .Range("Figures").End(xlDown)).ClearContents


    For lngCounter = 1 To intNoOfSamples
        blnDuplicate = True
        Do While blnDuplicate = True
            real_rnd = Rnd() * (lngPopulation - 1) + 1
            letter_lng = Abs(real_rnd)
            blnFound = False
            For i = 1 To lngCounter - 1
                If letter_lng = lngRandomFigureList(i) Then
                    blnFound = True
                End If
            Next i
            If blnFound = False Then
                blnDuplicate = False
            End If
        Loop

        lngRandomFigureList(lngCounter) = letter_lng
        .Range("A" & 6 + lngCounter).Value = letter_lng
    Next lngCounter
End With