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

根据条件生成随机名称列表

1 个答案: