在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
,你可以用随机生成的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
这将如何编码? –
你最初的评论让我想到了一个解决方案。不那么流畅,但它是一些东西。看到我的文章中的更新:)并感谢你 –
当你随机的东西,日之后没有办法排除已经出现的价值的外观。唯一合理的解决方案是检查已经出现最大次数的人,如果是,重新运行随机获得新名字。 – FDavidov
Acalally,你可以使用解算器而不是vba。它是一个内置的插件,旨在解决场景。网上有足够的教程。 –
您也可以删除/缩小可用名称的列表,一旦名称被使用了最长时间。一本字典对此很好。 –