Question

下面的代码在每个循环结束时运行得非常好我称之为“随机播放模块”，它随机地对列表中的名称进行混洗，并继续循环，随机化人员分配到每个日期的顺序，然而，由于人们并不总是可用，我发现人们被分配到连续的日期并不是必需的。比“洗牌”列表更好地依次分配。我正在努力解决的部分是如何循环遍历名称列表以及下一个日期分配何时从列表中的下一个人开始的问题。所以试着更容易解释一下。

名单列表在A栏中说1-20 B列有一个日期 C列有一个日期 D列有一个日期

日期B我需要3个人，日期C需要2个人，日期D需要5个人。在人员1开始分配时检查他们是否可用，如果他们是，那么它将他们分配到那个日期并移动到人2，依此类推。假设在该日期人员1,2和3都可用，那么人员1,2和3将被分配到该日期。当该列的分配完成后，程序移到B列，这里需要进行的是可用性检查应从第4个人开始，但我的代码再次从第1个人开始。这不是我想要的，检查必须从列表中的下一个人开始，而不是从头开始。是否有人能够建议我如何调整此代码以使其满足我的要求。希望有些善良的灵魂可以帮助我，因为我完全陷入困境。感谢您花时间看这个

Public Sub copyothers()
Dim listofcells As Range
Dim currentname As String
Dim foundrow As Integer
Dim foundcolumn As Integer
Dim counter As Integer
Dim i As Integer
Dim personcount() As Variant


Sheets("Availability").Activate

personcount = Sheets("Availability").Range("B3:AR3").Value 'check the number 
of people required in each column and record it for later

For i = 2 To 44
Sheets("Availability").Activate
Sheets("Availability").Range("a2").Select

counter = personcount(1, i - 1) - 1 'take the first number reduce it by 1 and move one column right right each time program loops
If Not Sheets("Availability").Cells(2, i) = "" Then
    Sheets("Availability").Range(Cells(2, i), Cells(2, i).End(xlDown)).Select
Else
    GoTo skip:  'If the column has no data then skip to next column
End If
Set listofcells = Selection

Sheets("allocation").Activate
Range("a2").Select


For Each singlecell In listofcells
        If counter > 0 Then
            If singlecell = "Available" Then
            foundcolumn = singlecell.Column 'record the column number where "Available" was found
            currentname = Sheets("Availability").Range("A" & singlecell.Row) 'record the name of the person in the row where "Available" was found
            Set foundName = Sheets("Allocation").Range("A:A").Find(What:=currentname, LookIn:=xlValues) 'find the persons name in "Allocation" sheet
            foundrow = foundName.Row
                If Sheets("allocation").Cells(foundrow, foundcolumn) = "" Then
                Sheets("allocation").Cells(foundrow, foundcolumn) = "X" 'place X in the same cell as it appeared in "Availability" sheet
                counter = counter - 1
                End If
            End If
        End If

Next singlecell

skip:
Call Shuffle
Next i

End Sub

Answer 1

不幸的是，由于声誉不佳，我不能仅仅发表评论，但我有几个问题。在你的if not / then语句中，你为什么称之为“Skip”？要转到下一列，只需将else部分留空可能会更有效。另外，代码的“Skip：”部分中的“Shuffle”的目的是什么？

另外，你可以尝试的一件事是代替

For singlecells in listofcells
*Code
Next Singlecell

尝试

For singlecells + marker in listofcells
*Code
mixer = mixer + 1
Next Singlecell

“标记”应该阻止您的程序再次重复每个人。

vba循环遍历名称列表并执行功能。在第二个循环开始，最后一个循环结束

1 个答案: