Question

我已经整理了一个工作簿，允许用户输入一些团队的名字，以及他们的相关评委（每个团队2个），这将创建一个随机的团队和评委的轮次列表

我遇到的问题是我想避免任何法官判断他们自己的团队。

我没有在这里解释整个工作簿，而是创建了一个应该做同样事情的简单版本。子程序如下：generateRandNum，它在单元格A1：A5中生成一个没有重复项的随机数列表 - 然后我使用VLOOKUP函数分配与单元格B1：B5中每个数字相关的相关团队名称。

Public Sub generateRandNum()

lowerbound = 1
upperbound = 5
Set randomrange = Range("A1:A5")

randomrange.Clear
For Each rng1 In randomrange
    counter = counter + 1
Next

If counter > upperbound - lowerbound + 1 Then
    MsgBox ("Number of cells > number of unique random numbers")
    Exit Sub
End If

For Each Rng In randomrange
    randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    Do While Application.WorksheetFunction.CountIf(randomrange, randnum) >= 1
        randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    Loop
    Rng.Value = randnum
Next
End Sub

generateRandJudge在单元格S11：T20中的10个名称的列表旁边的单元格S11：S20中生成没有重复的另一个随机数列表。

Public Sub generateRandJudge()

lowerbound = 1
upperbound = 10
Set randomrange = Range("s11:s20")

randomrange.Clear
For Each rng1 In randomrange
    counter = counter + 1
Next

If counter > upperbound - lowerbound + 1 Then
    MsgBox ("Number of cells > number of unique random numbers")
    Exit Sub
End If

For Each Rng In randomrange
    randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    Do While Application.WorksheetFunction.CountIf(randomrange, randnum) >= 1
        randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    Loop
    Rng.Value = randnum
Next
End Sub

再次使用VLOOKUP我取随机名称列表并将它们成对放置在单元格中（奇数）D1：D5和（偶数）F1：F5，其中团队与细胞E1：E5和G1：G5中的每个判断相关联分别

由于我想避免某人判断自己的团队，我在细胞H1中包含了以下IF函数：H5

= IF（OR（E1 = B1，G1 = B1），1,0）

然后我创建了另一个sub，以便用户只需按一个按钮即可生成随机列表：

Sub Main()
    Call generateRandNum
    Call generateRandJudge
'Check Judge values against Team values to avoid duplicates

    Dim i As Long
    For i = 1 To Rows.Count
    Next i
    If Cells(i, 8).Value = 1 Then
    Call generateRandNum
    End If

End Sub

子Main（）的第一部分工作正常，但最后一部分没有，但该行出现错误：

    If Cells(i, 8).Value = 1 Then

我想要它做的是循环遍历单元格H1：H5中的值，如果有任何等于1，那么它将生成另一组随机团队编号，直到没有重复并且它将停止。

我希望那里的人有比这更精致的解决方案。有人可以帮忙吗？

Answer 1

我怀疑这就是你想要的。

Sub Main()

    Dim i As Long
    Dim sht As Excel.Worksheet
    Dim rng As Range

    'Call generateRandNum
    'Call generateRandJudge

    Set sht = ThisWorkbook.Sheets("Test") ' Change worksheet name to real name in production

    Set rng = sht.Range("H1:H10") ' change parameters if required, or use a named range instead

    'Check Judge values against Team values to avoid duplicates
    With sht
        For i = 1 To rng.Rows.Count
            If .Cells(i, 8).Value = 1 Then Debug.Print "match at row: " & i 'Call generateRandNum
        Next i
    End With
End Sub

请注意我已经注释了您的函数调用，并考虑使用命名范围而不是固定范围以获得更大的灵活性。如果你这样做，你可以增加团队的数量，子服务仍然可以正常工作。另请注意，作为一般规则，您应该始终使用完全限定的参考资料，因为我在这里做。

Excel VBA使用随机数时，避免在不同列中使用重复值

1 个答案: