Excel: phân công lịch trực ngẫu nhiên với VBA

Chia sẻ đến các bạn đoạn mã VBA giúp phân công lịch trực cho nhân viên một cách ngẫu nhiên có loại trừ.

Chúng ta có 3 bảng tính như trên.

• 2 cột trái nhất là danh sách nhân viên tham gia trực;
• Bảng B là những mã nhân viên không thể trực tại ca đang ghi;
• Bảng 3 (C) sẽ là nơi bố trí nhân viên trực ngẫu nhiên & điều kiện là không bố trí trùng ca với danh sách (Bảng B) không thể trực;

Đoạn mã Macro sau đây sẽ thực hiện bố trí ca trực ngẫu nhiên này:

Sub LapLichTruc_1()
 Dim StrC As String, DSNg As String, BanNg As String, Ma_1 As String
 Dim Thu As Integer, Ca As Integer, Tmp As Integer, VTr As Integer
 Dim Cls As Range
 Const FC As String = "; "
'Chép Mã NV Vô Chuôi   '
 With Sheet3
    For Each Cls In .Range(.[A4], .[A4].End(xlDown))
        StrC = Cls.Value & StrC
        If Len(StrC) > 36 Then
            Randomize:                  Tmp = 5 * (2 + 4 * Rnd() \ 1)
            StrC = Mid(StrC, Tmp + 1, Len(StrC)) & Left(StrC, Tmp)
        End If
    Next Cls
'Phân Bô Lich Truc '
    Union([E11:K15], [E17:E27]).Value = ""
    For Thu = 5 To 11
       'Theo Thú Trong Tuân   '
       'Xáo Trôn Ca Dâu Tùng Ngày  '
        Randomize:                  Tmp = 5 * (1 + 5 * Rnd() \ 1)
        StrC = Mid(StrC, Tmp + 1, Len(StrC)) & Left(StrC, Tmp)
        DSNg = StrC
        For Ca = 3 To 7         'Theo Các Ca   '
            BanNg = Replace(Replace(.Cells(Ca, Thu).Value, " ", ""), ";", "")
            If Len(BanNg) < 5 Then
                Cells(Ca, Thu).Offset(8).Value = Left(DSNg, 5)
            Else
               'Xóa Danh Sách Các Cá Nhân Bân    '
                For Tmp = 1 To Len(BanNg) Step 5
                    Ma_1 = Left(BanNg, 5)
                    BanNg = Mid(BanNg, 6, Len(BanNg))
                    DSNg = Replace(DSNg, Ma_1, "")
                Next Tmp
                'Nhâp Nguòi Truc Ca Cua Các Ngày    '
                Cells(Ca, Thu).Offset(8).Value = Left(DSNg, 5)
            End If
            'Nhâp Thêm Ban Ca Truóc Vô Danh Sách Truc Ca Sau   '
            DSNg = Mid(DSNg, 6, Len(DSNg)) & BanNg
        Next Ca
    Next Thu
    MsgBox "Xong Rôi Nha!"
 End With
End Sub

Hy vọng với đoạn VBA Excel nho nhỏ giúp giải quyết công việc một cách nhanh chóng, chuyên nghiệp và tiết kiệm thời gian cho các bạn