Code vba đánh dấu ngày làm việc (1 người xem)

[Thuyanhanoi]

Chào các anh chị và các bạn thành viên GPE
mong được các anh chị và các bạn giúp code đánh dấu ngày làm việc theo yêu cầu. Chi tiết em ghi trong file đính kèm.
Xin cảm ơn các Anh Chị và Các Bạn

 

[Ba Tê]

Chào các anh chị và các bạn thành viên GPE
mong được các anh chị và các bạn giúp code đánh dấu ngày làm việc theo yêu cầu. Chi tiết em ghi trong file đính kèm.
Xin cảm ơn các Anh Chị và Các Bạn

Bạn chạy thử Sub này coi sao.

Public Sub GPE()
Dim Tmp, Arr(), I As Long, J As Long, R As Long, Nam As Long, Thang As Long, Num As Long
Nam = [AO1].Value: Thang = [AO2].Value
R = Range("A8").End(xlDown).Row - 6
Num = Day(DateSerial(Nam, Thang + 1, 0))
ReDim Arr(1 To R, 1 To 31)
With CreateObject("Scripting.Dictionary")
    If [AO4] <> Empty Then
        Tmp = Split([AO4], ";")
        For J = 0 To UBound(Tmp)
            .Add Val(Tmp(J)), ""
        Next J
    End If
    For J = 1 To Num
        Arr(1, J) = J
        If Not .Exists(J) Then
            If Weekday(DateSerial(Nam, Thang, J), 2) < 6 Then
                For I = 2 To R
                    Arr(I, J) = "x"
                Next I
            End If
        End If
    Next J
End With
Range("C7").Resize(100, 31).ClearContents
Range("C7").Resize(R, 31) = Arr
End Sub

 

[Thuyanhanoi]

Bạn chạy thử Sub này coi sao.

Public Sub GPE()
Dim Tmp, Arr(), I As Long, J As Long, R As Long, Nam As Long, Thang As Long, Num As Long
Nam = [AO1].Value: Thang = [AO2].Value
R = Range("A8").End(xlDown).Row - 6
Num = Day(DateSerial(Nam, Thang + 1, 0))
ReDim Arr(1 To R, 1 To 31)
With CreateObject("Scripting.Dictionary")
    If [AO4] <> Empty Then
        Tmp = Split([AO4], ";")
        For J = 0 To UBound(Tmp)
            .Add Val(Tmp(J)), ""
        Next J
    End If
    For J = 1 To Num
        Arr(1, J) = J
        If Not .Exists(J) Then
            If Weekday(DateSerial(Nam, Thang, J), 2) < 6 Then
                For I = 2 To R
                    Arr(I, J) = "x"
                Next I
            End If
        End If
    Next J
End With
Range("C7").Resize(100, 31).ClearContents
Range("C7").Resize(R, 31) = Arr
End Sub

Code chay như em mong muốn ạ!.
Em cảm ơn Thầy Ba Tê nhiều ạ!.