Erstellen eines Zeitplans mit VBA in Excel

Question

Ich arbeite an einem Zeitplan, der bestimmt, wer kochen wird und wer gerade mit Freunden unterwegs ist. Ich habe die Namen für die Teilnehmer in der Spalte "A" und mit CountIf, um zu sehen, wie oft die bestimmte Person auf dem Zeitplan erscheint, um es für alle gerecht zu machen. Der Code wählt 2 zufällige Personen zum Kochen und 2 für Gerichte aus, um sicherzustellen, dass sie nicht gleich sind. Dann setze ich diese Namen in den Zeitplan, den ich im Arbeitsblatt definiert habe. Mein aktueller Code sieht so aus und funktioniert so weit wie beabsichtigt.

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 

Gibt es eine Möglichkeit, einen Namen möglichst oft und minimal erscheinen zu lassen? Wie es jetzt aussieht, scheint 2 oder 3 Mal eine faire Zahl zu sein, wenn ich den Code ausführe und die CountIf-Ergebnisse ansehe.

UPDATE

Ich habe jetzt den Code zu arbeiten, wie beabsichtigt bekommen. Jede Person benötigt mindestens eine Koch- und Geschirrpflicht, daher sieht die Codierung jetzt so aus. Ich weiß es nicht, dass recht ist, aber es wird die Arbeit getan :)

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

Sie könnten Ihre Zufallsgenerierung in einer separte Funktion gesetzt, die das Arbeitsblatt überprüft, ob der ausgewählte Name bereits zweimal verwendet worden ist. Wenn false, gibt es den Namen zurück. Wenn dies der Fall ist, ruft die Funktion sich selbst auf (erzeugt also einen neuen Namen), bis ein Name gefunden wird, der Ihren Kriterien entspricht.

aktualisieren Bitte beachten Sie, dass dies eine Art von Pseudo-Code ist, die Sie nicht gedacht

In Ihrem Sub cookplan, arbeiten den Namen der Funktion jedes Mal fügen Sie einen neuen Namen benötigen

cook1 = GetName() 

Nach dem End Sub Sie eine neue Funktion einfügen genannt GetName (oder was auch immer Sie wollen)

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