Excel VBA Генерация случайного числа по порядку и в зависимости от того, сколько

Добрый день,

У меня есть сложная проблема с получением случайных чисел в отсортированном порядке в зависимости от того, сколько мне нужно либо по коду VBA, либо по формуле в VBA. Эта потребность генерируется случайным образом между 1 и 10.

Это выглядит примерно так, когда это начинается.

введите здесь описание изображения

и вот эффект, который я имел в виду, когда он показывает отсортированные числа в соответствии с тем, сколько из них не удалось в примере.

введите здесь описание изображения

Это одна попытка VBA, которую я сделал, когда ячейка J7 содержит случайное количество, которое мне нужно, но числа не совсем отсортированы. Я открыт для предложений/отзывов здесь. Большое спасибо.

Public Const BeCoolMachineCounter As String = "J7"
Public Const BeCoolMachineRange As String = "Q03:Q12"
'Generate the random data according to how many needed.
Call CreateNumbers(Range(BeCoolMachineRange), Range(BeCoolMachineCounter).Value)
Private Sub CreateNumbers(Which As Range, HowMany As Integer)
' Declaration of variables
    Dim c As Range
    Dim iCheck As Long

    iCheck = 1

' Generate random failures based on the number of required for each supplier
    For Each c In Which
        If iCheck <= HowMany Then
            c.Value = Random1to2192
            iCheck = iCheck + 1
        End If
    Next c
End Sub

random excel formula vba sorted
person Peter M Taylor    schedule 05.01.2013    source источник
comment
Если макет электронной таблицы статичен, я бы попробовал функцию рабочего листа SMALL.   -  person Jüri Ruut    schedule 05.01.2013
comment
Привет, Юрий, я не думаю, что здесь требуется МАЛЕНЬКАЯ функция рабочего листа, так как это подразумевает одно число. Спасибо, что предложили это.   -  person Peter M Taylor    schedule 06.01.2013
comment
=SMALL($B$3:$B$12),ROW()-2 скопированный из C3 в ячейки C3:C12 вашего примера, сортирует все ваши выходные данные.   -  person Jüri Ruut    schedule 06.01.2013

Ответы (2)


arrow_upward
2
arrow_downward

Вы можете использовать формулу массива в целевом диапазоне и пользовательскую функцию, возвращающую массив.

Это дает вам именно тот результат, который вы показываете.

Итак, УДФ:

Public Function GetRandomFailures(count As Long) As Variant
    Dim result As Variant, numbers As Variant
    ReDim result(100)
    ReDim numbers(count - 1)

    For i = 0 To count - 1
        numbers(i) = Application.WorksheetFunction.RandBetween(1, 10000)
    Next i

    Call QuickSort(numbers, LBound(numbers), UBound(numbers))

    For i = 0 To 99
        If i < count Then
            result(i) = numbers(i)
        Else
            result(i) = ""
        End If
    Next i

    GetRandomFailures = Application.WorksheetFunction.Transpose(result)
End Function

Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)

  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi) \ 2)

  While (tmpLow <= tmpHi)

     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If

  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi

End Sub

и примерная формула:

{=GetRandomFailures(A1)}

(скобки добавлены Excel)

Конечно, вы можете просто вызвать этот UDF из макроса, но IMHO, используя формулу массива, может улучшить взаимодействие с пользователем, поскольку все прозрачно, и список обновляется каждый раз, когда вы меняете количество.

Примечание. Реализация быстрой сортировки взята отсюда: функция сортировки массива VBA?

person Pragmateek    schedule 05.01.2013
comment
спасибо за предложение. Я проверю код и дам вам знать. - person Peter M Taylor; 06.01.2013
comment
спасибо Serious, все работает как я хотел. Это решило мою проблему, как только я вспомнил, как делать формулы CSE. - person Peter M Taylor; 06.01.2013

arrow_upward
1
arrow_downward

Я не уверен, что понимаю, что вы сказали, но, основываясь на до и после, я предположил, что у вас уже есть 10 чисел в столбце, и вы хотите получить случайную выборку размером HowMany из них, а затем убедитесь, что взятые числа затем отсортированы по порядку.

Public Sub RandomSample(Data10 As Range, HowMany As Integer)

    ' Insert random numbers next to the data
    Data10.Cells(1, 2).FormulaR1C1 = "=RAND()"
    Data10.Cells(1, 2).AutoFill Destination:=Range(Data10.Cells(1, 2), Data10.Cells(10, 2))

    ' Sort the data by the random numbers
    Range(Data10.Cells(1, 1), Data10.Cells(10, 2)).Sort key1:=Data10.Cells(1, 2), header:=xlNo
    ' Remove the random numbers
    Range(Data10.Cells(1, 2), Data10.Cells(10, 2)).ClearContents

    ' Remove numbers surplus to HowMany
    If HowMany < 10 Then
        Range(Data10.Cells(HowMany + 1, 1), Data10.Cells(10, 1)).ClearContents
    End If

    ' Resort the remaining numbers
    Range(Data10.Cells(1, 1), Data10.Cells(HowMany, 1)).Sort key1:=Data10.Cells(1, 1), header:=xlNo

End Sub

Вы можете вызвать это с помощью RandomSample Range("B3:B12"),6

person Morbo    schedule 05.01.2013
comment
Привет, Морбо. Да, это правильно, 10 номеров и в порядке сортировки. Я использовал 10 чисел в статических изображениях, которые я предоставил в качестве небольшого образца для иллюстративных целей. Я посмотрю, что делает этот код, и посмотрю, соответствует ли он тому, что я имел в виду. Спасибо. - person Peter M Taylor; 06.01.2013
comment
Я попробовал этот код, и я считаю, что сортировка не работает, поскольку она очищает данные после заполнения. - person Peter M Taylor; 06.01.2013
comment
У меня это сработало в Excel 2003, как я описал в комментариях. Если вы хотите 3 номера, он удалит оставшиеся 7 номеров. - person Morbo; 06.01.2013