Создать случайный список имен на основе критериев

Question

Я получил случайный список для генерации из основного списка и исключил 2 элемента из этого списка (thing 1 & thing 2), однако, даже после запуска макроса несколько раз, он все равно будет время от времени заполнять эти исключенные элементы.

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

Sub populate()

Dim usedList As Object
Set usedList = CreateObject("Scripting.Dictionary")

    usedList.Add "thing 1", 1
    usedList.Add "thing 10", 2


Dim SrcRange As Range, FillRange As Range
Dim c As Range, r As Long

Dim i As Integer
i = 12
Set SrcRange  = Sheets("Staffing").Range("B2:B21")
Set FillRange  = Sheets("Staffing").Range("F2:F" & i)

r = SrcRange.Cells.Count
For Each c In FillRange
Do
c.Value = WorksheetFunction.Index(SrcRange, Int((r * Rnd) + 1))
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2

If usedList.Exists(c.Value) Then
    c.Value = WorksheetFunction.Index(SrcRange, Int((r * Rnd) + 1))
End If

Next
End Sub

Answer 1

Я думаю, что это работает. Я добавил Do Loop, чтобы дважды проверить значение по списку. Я уже запускал его несколько раз, и, похоже, это исправлено. Пожалуйста, подтвердите! Надеюсь, это кому-нибудь поможет.

    For Each c In FillRange
    Do
        c.Value = WorksheetFunction.Index(SrcRange, Int((r * Rnd) + 1))
        If usedList.Exists(c.Value) Then
            Do While usedList.Exists(c.Value)
                c.Value = WorksheetFunction.Index(SrcRange, Int((r * Rnd) + 1))
            Loop

        End If
    Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2

Next c