Microsoft ExcelでVBAを使用してユニークな乱数のリストを生成

Option Explicit

Function UniqueRandomNumbers(NumCount As Long, LLimit As Long, ULimit As Long) As Variant

'Declaring variables

Dim RandColl As Collection

Dim i As Long

Dim varTemp() As Long

'Validation check for the value specified by the user

If NumCount < 1 Then

UniqueRandomNumbers = "Number of unique random number required is less than 1"

Exit Function

End If

If LLimit > ULimit Then

UniqueRandomNumbers = "Specified lower limit is greater than specified upper limit"

Exit Function

End If

If NumCount > (ULimit - LLimit + 1) Then

UniqueRandomNumbers = "Number of required unique random number is greater than maximum number of unique number that can exists between lower limit and upper limit"

Exit Function

End If

'Creating new object of collection

Set RandColl = New Collection

Randomize

Do

On Error Resume Next



'Calculating the random number that exists between the lower and upper limit

i = CLng(Rnd() * (ULimit - LLimit) + LLimit)



'Inserting the  unique random number in the collection

RandColl.Add i, CStr(i)



On Error GoTo 0

'Looping until collection have items equal to numCount

Loop Until RandColl.Count = NumCount

ReDim varTemp(1 To NumCount)

'Assigning value of the items in the collection to varTemp array

For i = 1 To NumCount

varTemp(i) = RandColl(i)

Next i

UniqueRandomNumbers = varTemp

Set RandColl = Nothing

Erase varTemp

End Function

Sub TestUniqueRandomNumbers()

'Declare variables

Dim RandomNumberList As Variant

Dim Counter As Long, LowerLimit As Long, UpperLimit As Long

Dim Address As String

'Getting the values input by the user

Counter = Range("C14").Value

LowerLimit = Range("C12").Value

UpperLimit = Range("C13").Value

Address = Range("C15").Value

'Calling custom function UniqueRandomNumbers

RandomNumberList = UniqueRandomNumbers(Counter, LowerLimit, UpperLimit)

'Selecting the destination

Range(Address).Select

'Assigning the value in the destination

Range(Selection, Selection.Offset(Counter - 1, 0)).Value = _

Application.Transpose(RandomNumberList)



End Sub