Как сгенерировать список имен в случайном порядке без повторов? - PullRequest
0 голосов
/ 16 июня 2020

Я попытался создать список имен в случайном порядке, без повторов в ячейках с E2 по E16. Вы можете увидеть результаты ниже. enter image description here

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

Sub Button1_Click()
'Must be a dynamic array ie no range
Dim MyNames() As String
Dim strName As String
Dim Ichosen As Integer
'load list into Array based on split by /
'note will start as MyNums(0) and finish with MyNums(number-1)
MyNames = Split("John/Bill/Steve/Echo/Sandy/A/B/C/D/E/F/G/H/I/J", "/")
Do
    Randomize
    'This will work with any length of name sequence
    Ichosen = Int(Rnd * (UBound(MyNames) + 1))
    strName = (MyNames(Ichosen))
    Range("E2:E16").Value = strName
    'move top num,ber into chosen slot
    MyNames(Ichosen) = MyNames(UBound(MyNames))
    If UBound(MyNames) > 0 Then
        'delete top number
        ReDim Preserve MyNames(0 To UBound(MyNames) - 1)
    Else
        Exit Sub
    End If
Loop
End Sub

1 Ответ

0 голосов
/ 16 июня 2020

Я адаптировал ваш код. Попробуйте:

Dim MyNames() As String
Dim strName As String
Dim Ichosen As Integer

Dim i As Long, TotalRandoms As Long
i = 2 'starting row

'load list into Array based on split by /
'note will start as MyNums(0) and finish with MyNums(number-1)
MyNames = Split("John/Bill/Steve/Echo/Sandy/A/B/C/D/E/F/G/H/I/J", "/")
TotalRandoms = UBound(MyNames) + 2
Dim str As String

Do Until i > TotalRandoms

    Randomize
    'This will work with any length of name sequence
    Ichosen = Int(Rnd * (UBound(MyNames) + 1))
    strName = (MyNames(Ichosen))
    str = Join(MyNames, "/")
    If Right(str, Len(strName) + 1) = "/" & strName Then
        str = Replace(str, "/" & strName, "")  'we replace strname in last position of array
    Else
        str = Replace(str, strName & "/", "") 'we replace strname in any position of array (except last one)
    End If

    Range("E" & i).Value = strName
    Erase MyNames
    MyNames = Split(str, "/")
    i = i + 1
Loop

Erase MyNames

enter image description here

Это очень похоже на оригинал от вас, но я изменил способ избавления вашего массива от уже используемых элементов . Кроме того, изменился способ присваивания значений ячейке с помощью переменной.

Я сделал несколько прогонов и, похоже, все в порядке. Никаких дубликатов и всего прочего.

Надеюсь, вы сможете адаптировать это под свои нужды.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...