ExcelでVBAを使ってスケジュールを作成する

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回は公平な数字のようです。

UPDATE

私は今、意図したとおりに動作するコードを得ています。各人は少なくとも1つの料理と皿の義務を必要とするので、コーディングはこれで今のようになります。私はそれはきれいではありません知っているが、それは仕事を取得します:)

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

あなたが選択した名前がすでに2回使用されている場合は、ワークシートをチェックしseparte機能、であなたのランダム生成を入れることができます。 falseの場合、名前を返します。 trueの場合、関数は自分の条件を満たす名前が見つかるまで、それ自身を呼び出します（したがって、新しい名前を生成します）。

更新これはあなたのサブcookplanで

を動作するように意図されていない擬似コードのいくつかの種類であることを、注意してください、あなたは新しい名前を必要とする機能毎回の名前を追加

あなたが新しい項目GetName呼ばFunktion（またはものは何でもしたい）を挿入End Subの後

cook1 = GetName() 

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