1. 下载vba文件


2. 请在Column A , B和C依序输入工作人员的名字


3. 然后按橙色的按钮


4. 为避免麻烦，每一次排班，最好用新的 Item 1 文件,再重复步骤2和3即可




5. 其他：此次用到的VBA代码



Option Explicit
Dim myCounter As Integer


Sub main()
  myCounter = 1
  Call toInputFullList
  Call toPopulate_Zheng
  
  
  Application.CutCopyMode = False
  MsgBox "排班完成 ^^"
  Range("A1").Activate
End Sub


Sub toInputFullList()
    Dim myOutput As Range
    Set myOutput = Cells.Find("Output >>>", lookat:=xlWhole)
    Range(Range("A2"), Range("A1").End(xlDown)).Copy
    myOutput.Offset(0, 1).PasteSpecial xlPasteValues, , , True
    
    Set myOutput = Nothing
End Sub

Sub toPopulate_Zheng()
    Dim myOutput As Range
    Dim cell As Range
    Set myOutput = Cells.Find("Output >>>", lookat:=xlWhole)
    myOutput.Offset(0, 1).Activate
    
    For Each cell In Range(myOutput.Offset(1, 0), myOutput.End(xlDown))
        If Len(cell) > 0 Then
            If Len(ActiveCell) = 0 Then
                myOutput.Offset(0, 1).Activate
            End If
            
            Cells(cell.Row, ActiveCell.Column) = "正"
            Call toPopulate_Fu(cell.Row)

            ActiveCell.Offset(0, 1).Activate
        End If
    Next cell
    
    Set myOutput = Nothing
End Sub

Sub toPopulate_Fu(myRow As Integer)
    Dim myFinding As Range
    Dim myColumn As Integer
    Dim cell As Range
    Dim myCollection As New Collection
    Dim myOutput As Range
    Set myOutput = Cells.Find("Output >>>", lookat:=xlWhole)
    
    For Each cell In Range(Range("C2"), Range("C1").End(xlDown))
        myCollection.Add cell.Value
    Next cell
    
    Set myFinding = Range(Range("B2"), Range("B1").End(xlDown)).Find(ActiveCell.Value, lookat:=xlWhole)
    
    
    If Not myFinding Is Nothing Then
        myColumn = Range(myOutput, myOutput.End(xlToRight)).Find(myCollection(myCounter), lookat:=xlWhole).Column
        Cells(myRow, myColumn).Value = "副"
        myCounter = myCounter + 1
        
        If myCounter > myCollection.Count Then
            myCounter = 1
        End If
        
    End If
    
    Set myFinding = Nothing
    Set myOutput = Nothing
End Sub
              
            

Source: ---

---

Disclaimer: The information in this webpage is shared by anonymous users from external online sources. We cannot guarantee its accuracy or truthfulness. Users should exercise caution and verify information independently.

---