Question

我正在制定一个时间表来确定谁将要做饭，以及谁和一些朋友一起去旅行做菜。我有“A”列中列出的参与者的姓名，并使用CountIf查看特定人员在计划中出现的次数，以使每个人都公平。该代码选择2个随机人员进行烹饪，2个人选择菜肴以确保它们不相同。然后将这些名称放入我在工作表中定义的计划中。我目前的代码看起来像这样，并且正在按预期工作。

Private Sub cookplan()
last_row = Range("A1").End(xlDown).Row
Dim awesome()
Dim index1 As Integer
Dim index2 As Integer
Dim cook1 As String
Dim cook2 As String
Dim dish1 As String
Dim dish2 As String
ReDim awesome(last_row - 1, 0)
For i = 0 To last_row - 1
    awesome(i, 0) = Range("A" & i + 1)
Next

For i = 1 To 5
        index1 = Int((last_row - 1 - 0 + 1) * Rnd + 0)
        cook1 = awesome(index1, 0)
        Cells(i * 2, 6).Value = cook1

        Do
            index2 = Int((last_row - 1 - 0 + 1) * Rnd + 0)
            cook2 = awesome(index2, 0)
            Cells(i * 2, 7).Value = cook2
        Loop While cook2 = cook1

        Do
            index1 = Int((last_row - 1 - 0 + 1) * Rnd + 0)
            dish1 = awesome(index1, 0)
        Loop While dish1 = cook1 Or dish1 = cook2

        Do
            index2 = Int((last_row - 1 - 0 + 1) * Rnd + 0)
            dish2 = awesome(index2, 0)
        Loop While dish2 = cook1 Or dish2 = cook2 Or dish2 = dish1

        Cells(i * 2, 8).Value = dish1
        Cells(i * 2, 9).Value = dish2
Next
End Sub

有没有办法让名字出现最大和最小次数？就像现在一样，当我运行代码并查看CountIf结果时，2或3次似乎是一个公平的数字。

更新

我现在已经让代码按预期工作了。每个人至少需要一个烹饪和餐具，因此编码现在看起来像这样。我知道它不是那么漂亮，但它完成了工作：）

Private Sub cookplan()
last_row = Range("A1").End(xlDown).Row
Dim awesome()
Dim index As Integer
Dim cook1 As String
Dim cook2 As String
Dim dish1 As String
Dim dish2 As String
Dim counter1 As Integer
Dim counter2 As Integer
ReDim awesome(last_row - 2, 0)
For i = 0 To last_row - 2
    awesome(i, 0) = Range("A" & i + 2)
Next
Do
    For i = 1 To 5
        Do
            index = Int((last_row - 2 - 0 + 1) * Rnd + 0)
            cook1 = awesome(index, 0)
            Cells(i * 2, 6).Value = cook1
        Loop While Cells(index + 2, 2) > 2 Or Cells(index + 2, 3) > 2
        Do
            index = Int((last_row - 2 - 0 + 1) * Rnd + 0)
            cook2 = awesome(index, 0)
            Cells(i * 2, 7).Value = cook2
        Loop While Cells(index + 2, 2) > 2 Or Cells(index + 2, 3) > 2 Or cook2 = cook1
        Do
            index = Int((last_row - 2 - 0 + 1) * Rnd + 0)
            dish1 = awesome(index, 0)
            Cells(i * 2, 8).Value = dish1
        Loop While Cells(index + 2, 2) > 2 Or Cells(index + 2, 3) > 2 Or dish1 = cook1 Or dish1 = cook2
        Do
            index = Int((last_row - 2 - 0 + 1) * Rnd + 0)
            dish2 = awesome(index, 0)
            Cells(i * 2, 9).Value = dish2
        Loop While Cells(index + 2, 2) > 2 Or Cells(index + 2, 3) > 2 Or dish2 = cook1 Or dish2 = cook2 Or dish2 = dish1
    Next
    counter1 = 0
    counter2 = 0
    For i = 2 To last_row
        If Cells(i, 2).Value = 0 Then
            counter1 = counter1 + 1
        End If
        If Cells(i, 3).Value = 0 Then
            counter2 = counter2 + 1
        End If
    Next
Loop While counter1 > 0 Or counter2 > 0
End Sub

Answer 1

如果所选名称已被使用过两次，您可以将随机生成放入一个separte函数中，该函数检查工作表。如果为false，则返回名称。如果为true，则函数调用自身（因此生成新名称），直到找到符合您标准的名称。

更新请注意，这是某种伪代码，不适用于

在Sub cookplan中，每次需要新名称时都会添加功能名称

cook1 = GetName()

在End Sub之后插入一个名为GetName（或任何你想要的）的新Funktion

Function GetName() As String

    'Determine your name here
    If CountForDeterminedName > 2 Then

        'Call Function Again to find another Name
        GetName = GetName()

    Else

        GetName = DeterminedName

    End If

End Function

在Excel中使用VBA制定计划

1 个答案: