在Excel中使用VBA制定计划

在Excel中使用VBA制定计划

问题描述:

我正在制定一个计划,确定谁要去做饭,谁和一些朋友一起做菜。 我列出“A”列中列出的参与者的姓名,并使用CountIf来查看特定人员出现在日程安排中的次数,以使每个人都公平。该代码挑选2个随机人员做饭,2个做菜以确保他们不一样。然后将这些名称放入我在工作表中定义的日程表中。 我目前的代码看起来像这样,并且工作到目前为止。在Excel中使用VBA制定计划

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

我现在已经得到了代码,旨在工作。每个人都需要至少一种烹饪和美食,所以现在编码看起来就像这样。我知道这是不是很漂亮,但它能够完成任务:)

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 
+0

当你随机的东西,日之后没有办法排除已经出现的价值的外观。唯一合理的解决方案是检查已经出现最大次数的人,如果是,重新运行随机获得新名字。 – FDavidov

+0

Acalally,你可以使用解算器而不是vba。它是一个内置的插件,旨在解决场景。网上有足够的教程。 –

+0

您也可以删除/缩小可用名称的列表,一旦名称被使用了最长时间。一本字典对此很好。 –

,你可以用随机生成的separte功能,即检查工作,如果选择的名称已经被使用了两次。如果为false,则返回名称。如果为true,则函数会自行调用(因此会生成一个新名称),直到找到符合条件的名称。

更新请注意,这是某种形式的伪代码,这是不打算工作

在你的子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 
+0

这将如何编码? –

+0

你最初的评论让我想到了一个解决方案。不那么流畅,但它是一些东西。看到我的文章中的更新:)并感谢你 –