Question

我是新手，需要帮助我需要创建一个宏。目标是从名单列表中随机选择合作伙伴进行多米诺骨牌匹配。

详细信息：
我将在列＃34; B＆＃34;中列出一系列玩家，每天可能会有不同数量的玩家和不同的名字。在专栏＃34; A＆＃34;那些球员将拥有一个独特的号码。宏应该成对组合这些玩家，那些合作伙伴将与另一对随机选择对。我会在一个单元格上指定每个玩家当天玩多少次。限制是：

在使用所有组合之前，没有两个玩家应该第二次在团队中一起玩，等等。
在使用所有组合之前，没有两个相同的队伍应该第二次相互比赛。

我需要从宏中回来......

D栏：第1队，（队员1号码）。
E栏：第1队，（队员2号）。
F栏：第2队，（球员1号）。
G栏：第2队，（球员2号）。

我只需要这个号码，因为我的计划是使用vlookup从主列表中获取名称。每一行都是不同的匹配。例如，我有8个玩家，每个玩5次，最后，我应该有10行匹配：

8 players x 5 games per player = 40 / 4 players each match = 10

如果您有任何疑问，请告诉我。感谢。

这是我到目前为止的代码：

Sub SelectRandomPlayers()

    Dim players() As String, selectedPlayers(3) As String
    Dim playerRange As Range
    Dim i As Long, c As Long, writeRow As Long, ub As Long, selectedIndex As Long, j As Long, ub2 As Long

    writeRow = 2

    Set playerRange = Range(Range("A2"), Range("A2").End(xlDown))
    c = playerRange.count
    ub = c - 1
    ReDim players(ub)

    For i = 0 To ub
        players(i) = playerRange.Cells(i + 1).Value2
    Next i

    Do
        For i = 0 To 3
            ub2 = UBound(players)
            selectedIndex = WorksheetFunction.RandBetween(0, ub2)
            selectedPlayers(i) = players(selectedIndex)

            For j = selectedIndex To ub2
                If j < ub2 Then players(j) = players(j + 1)
            Next j

            If ub2 > 0 Then ReDim Preserve players(ub2 - 1)
        Next i

        Range("D" & writeRow).Value2 = selectedPlayers(0)
        Range("E" & writeRow).Value2 = selectedPlayers(1)
        Range("F" & writeRow).Value2 = selectedPlayers(2)
        Range("G" & writeRow).Value2 = selectedPlayers(3)
        writeRow = writeRow + 1
    Loop While UBound(players) > 0
End Sub

我仍然无法确定如何更改它，因此每位玩家可以有多个匹配并遵守约束条件。

随机选择Excel VBA Dominoes团队

0 个答案: