Bố trí lịch trực 5 ca/ ngày trong tuần không trùng với lịch báo bận (của nhân viên)

  • Thread starter SA_DQ
  • Ngày gửi
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
583
103
43
67
HCM city
Trực.jpg

Trên đây là hình ảnh trang dữ liệu (DL); nó gồm 3 bảng:
Bảng A (là 2 cột DL ở cột A & B) gồm liệt kê danh sách các nhân viên tham gia trực trong tuần & mã (duy nhất của họ)
Bảng B (bên phải phía trên) là bảng ghi danh những NV không thể trực vào các ca & ngày cụ thể nào đó;
Bảng cuối là để 1 macro bố trí những nhân viên khác (bảng B) trong ca & ngày trực ngẫu nhiên

Bảng lịch trực ngẫu nhiên được tạo bỡi macro có nội dung như sau:
PHP:
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 = "; "
1 '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
2 'Phân Bô Lich Truc '
    Union([E11:K15], [E17:E27]).Value = ""
    For Thu = 5 To 11             'Theo Thú Trong Tuân   '
3 '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
4                '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
5                'Nhâp Nguòi Truc Ca Cua Các Ngày    '
                Cells(Ca, Thu).Offset(8).Value = Left(DSNg, 5)
            End If
6            '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
 
Khóa học Quản trị dòng tiền
M

MINA

Quảng cáo/Tài Trợ
Thành viên BQT
Quản lý cao cấp
12/11/03
4,075
413
83
46
Ninh Thuận

Xem nhiều

Webketoan Zalo OA