Сформировать список уникальных случайных чисел с помощью VBA в Microsoft Excel
В этой статье мы создадим настраиваемую функцию для создания списка уникальных и случайных чисел между указанными диапазонами.
В этом примере мы можем запустить макрос, нажав кнопку «Отправить».
Перед запуском макроса мы должны ввести значения для четырех параметров. Мы предоставили нижнее предельное значение в ячейке C12, верхнее предельное значение в ячейке C13, количество уникальных случайных чисел, необходимых в ячейке C14, и адрес назначения, который требуется выводить в ячейке C15.
Логическое объяснение
Мы создали специальную функцию «UniqueRandomNumbers» для создания списка уникальных и случайных чисел. Эта функция принимает необходимое количество, нижний и верхний предел в качестве входных параметров.
Мы создали макрос «TestUniqueRandomNumbers» для вызова пользовательской функции «UniqueRandomNumbers». Этот макрос запускается при нажатии кнопки «Отправить». Этот макрос принимает значение, введенное пользователем, из диапазона от C12 до C15.
Объяснение кода
i = CLng (Rnd () * (ULimit — LLimit) + LLimit)
Вышеупомянутая формула используется для создания случайного числа между определенным верхним и нижним пределом. Функция Rnd () создает случайное число от 0 до 1.
Диапазон (Selection, Selection.Offset (Counter — 1, 0)). Value = _ Application.Transpose (RandomNumberList)
Приведенный выше код используется для транспонирования вывода массива и назначения вывода указанному месту назначения.
Пожалуйста, введите код ниже
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
Если вам понравился этот блог, поделитесь им с друзьями на Facebook и Facebook.
Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]