VBA随机分配名称到组而不重复

Question

我正在寻找一个将名称随机分配到一个组中的宏。有16个组，每个组都需要随机分配10个名称。名单列表在不同的表格上，理想情况下我只想运行一个宏，它将列表中的10个随机名称粘贴到每个组中而不重复。这可能吗？我在其他任何地方都没有找到解决方案。

Answer 1

根据以下假设：

1. 人名在名为“Persons”的工作表的A列中，此处的B列是免费的
2. 团队表名为“表”，“团队负责人1”在A1，“团队负责人2”在B1等，“团队负责人9”在A13，“团队负责人10”是在B13等
3. 人员名单是下一个人之前没有黑色空格的连续名单
4. 您可以创建一个命令按钮，并从以下代码将其分配给CreateTeams_BtnClick（）：

:)插入笑脸，因为在编号列表后插入代码括号会变得混乱

Public Sub CreateTeams_BtnClick()
CreateTeams
End Sub
Private Sub CreateTeams()
Dim teamsSheet, personsSheet As Worksheet
Set teamsSheet = Worksheets("Teams")
Set personsSheet = Worksheets("Persons")


personsSheet.Range("A:A").Copy Destination:=personsSheet.Range("B:B")

Dim numPersons As Integer
numPersons = personsSheet.Range("B:B").End(xlDown).row

Dim startRow As Integer
startRow = 2
Dim startCol As Integer
startCol = 1
Dim personNumber As Integer

For i = 1 To 16
    For j = 1 To 10
        personNumber = Int((numPersons - 1 + 1) * Rnd() + 1)
        teamsSheet.Cells(startRow, startCol).Value = personsSheet.Cells(personNumber, 2).Value
        personsSheet.Cells(personNumber, 2).Delete Shift:=xlUp
        numPersons = numPersons - 1
        startRow = startRow + 1
    Next j

    If i < 8 Then
        startRow = 2
        startCol = startCol + 1
    ElseIf i = 8 Then
        startRow = 14
        startCol = 1
    Else
        startRow = 14
        startCol = startCol + 1
    End If
Next i
End Sub