Cho hỏi nha, Chủ nhật cũng chấm công nữa hả bạn?
Nếu ngày đầu tháng là CN thì ngày CN cuối cùng của tháng đó sẽ là ngày 29 & như thế chỉ 5 cái CN thôi.
Có nơi lại làm chủ nhật nghỉ thứ bảy bác ạ.
- Em sửa lại rồi ạ
Lẽ ra như vầy mới đúng chứ nhỉ?
dạ không hưởng lương ạ, xem như mình có việc mình xin nghỉ thôi ạ
1) Hàng 1, tại ô A1 bạn chỉ gõ ngày 1/12/2020 (nói chung là ngày đầu tháng của một tháng nào đó), tôi đã định dạng cho nó thành "BẢNG CHẤM CÔNG THÁNG " mm/yyyy, như thế bạn không phải gõ gì thêm.
Bác ơi, hình như bác hiểu nhầm ý em rồi ạ. Em muốn làm bài toán ngược ấy bác ạ, điền hết các ngày công, nghỉ lễ, nghỉ phép rồi sau đó bấm là chạy ngược ra đánh "x", "x/2", "P",... sao cho phù hợp với thông tin mình đã điền ở ô bôi vàng ấy bác ạ
Bạn cho tôi biết nếu như x/2 thì sẽ được nhét vào ngày nào?
Bác ơi, vậy có cách nào đơn giản chỉ cần đánh số ngẫu nhiên theo ngày công không ạ, ví dụ là 26 thì nó tự đánh ngẫu nhiên 26 "x" cho mình không ạ, không cần phải theo từng trường hợp nữa ạ
Khó cái là 11 ngày lễ, trong đó những ngày lễ âm lịch như Giỗ Tổ Hùng Vương, Tết Nguyên Đán thì làm sao mà biết ngày nào mà chấm? Giờ lễ Quốc khánh lại có thêm 1 ngày, chẳng biết nó là ngày 1/9 hay 3/9, rồi nghỉ bù lễ như thế nào v.v...
Tất tần tật các ngày lễ đều phải qui chuyển về dương lịch;
Theo file không xét ngày lể
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j&
If Target.Address = "$A$1" Then
If IsDate(Target.Value) Then
Application.EnableEvents = False
Target.Value = Target.Value - Day(Target.Value) + 1
j = DateAdd("m", 1, Range("E3")) - Range("E3")
Range("AF3:AI3").EntireColumn.Hidden = False
If j < 31 Then Range("E3").Offset(, j).Resize(, 31 - j).EntireColumn.Hidden = True
Application.EnableEvents = True
End If
End If
End SubSub XYZAB()
Dim sArr(), aNgay(), aThuong(), aT7(), aCN(), arr, res()
Dim soNgay&, NgayThuong&, soT7&, soCN&
Dim NgayLV&, lvCH&, lvT7&, NuaNgay#
Dim sRow&, i&, j&, k&, k2&, k3&, N&, M&
Randomize
soNgay = DateAdd("m", 1, Range("E3")) - Range("E3")
aNgay = Range("E3").Resize(, soNgay)
sArr = Range("AJ7:AN" & Range("B1000").End(xlUp).Row).Value
sRow = UBound(sArr)
ReDim res(1 To sRow + 1, 1 To 31)
ReDim aThuong(1 To soNgay)
ReDim aT7(1 To 10): ReDim aCN(1 To 10)
For j = 1 To soNgay
res(sRow + 1, j) = Weekday(aNgay(1, j), vbMonday)
If res(sRow + 1, j) = 7 Then
soCN = soCN + 1 'So ngay CN
k = k + 1
aCN(k) = j
ElseIf res(sRow + 1, j) = 6 Then
soT7 = soT7 + 1 'So ngay Thu 7
k2 = k2 + 1
aT7(k2) = j
Else
k3 = k3 + 1
aThuong(k3) = j
End If
Next j
For i = 1 To sRow
If sArr(i, 4) > soT7 Or sArr(i, 5) > soCN Then _
MsgBox ("So ngay nghi T7 hoac CN sai!"): Exit Sub
'Ngay thuong
NgayThuong = soNgay - soT7 - soCN 'So ngay thuong
sArr(i, 4) = soT7 - sArr(i, 4) 'So ngay lam viec thu 7
sArr(i, 5) = soCN - sArr(i, 5) 'So ngay lam viec CN
sArr(i, 1) = sArr(i, 1) - Int(sArr(i, 4) + 0.5) - Int(sArr(i, 5) + 0.5)
NuaNgay = NgayThuong - sArr(i, 1) - sArr(i, 2) - sArr(i, 3) 'So ngay thuong lam nua ngay
If NuaNgay < 0 Then MsgBox ("So ngay Lam Viec va Nghi qua lon!"): Exit Sub
NgayLV = sArr(i, 1) - NuaNgay 'So ngay thuong lam 1 ngay
NuaNgay = NuaNgay * 2 'So ngay thuong lam nua ngay
arr = UniqueRand(NgayThuong)
k = 0
For j = 1 To NgayLV '1 Ngay
k = k + 1
jcol = aThuong(arr(k))
res(i, jcol) = "X"
Next j
For j = 1 To NuaNgay 'Nua ngay
k = k + 1
jcol = aThuong(arr(k))
res(i, jcol) = "X/2"
Next j
For j = 1 To sArr(i, 2) 'Nghi khong luong
k = k + 1
jcol = aThuong(arr(k))
res(i, jcol) = "0"
Next j
For j = 1 To sArr(i, 2) 'Nghi co luong
k = k + 1
jcol = aThuong(arr(k))
res(i, jcol) = "L"
Next j
'Thu 7
k = 0
N = Int(sArr(i, 4))
M = Int(sArr(i, 4) + 0.5)
arr = UniqueRand(soT7)
For j = 1 To N '1 ngay
k = k + 1
jcol = aT7(arr(k))
res(i, jcol) = "X"
Next j
For j = 1 To M - N 'Nua ngay
k = k + 1
jcol = aT7(arr(k))
res(i, jcol) = "X/2"
Next j
'Chu nhat
k = 0
N = Int(sArr(i, 5))
M = Int(sArr(i, 5) + 0.5)
arr = UniqueRand(soCN)
For j = 1 To N '1 ngay
k = k + 1
jcol = aCN(arr(k))
res(i, jcol) = "X"
Next j
For j = 1 To M - N 'Nua ngay
k = k + 1
jcol = aCN(arr(k))
res(i, jcol) = "X/2"
Next j
Next i
Range("E7").Resize(sRow, 31) = res
End Sub
Function UniqueRand(ByVal N As Long) As Variant
Dim arr() As Long, i As Long, RndNum As Long, tmp As Long
ReDim arr(1 To N)
'Randomize
For i = 1 To N
RndNum = Int(N * Rnd() + 1)
If arr(RndNum) = 0 Then tmp = RndNum Else tmp = arr(RndNum)
If arr(N) = 0 Then arr(RndNum) = N Else arr(RndNum) = arr(N)
arr(N) = tmp
N = N - 1
Next i
UniqueRand = arr
End FunctionRút gọn lại và điều chỉnh vài lệnh sai
Sub XYZAB()
Dim sArr(), aNgay(), aThuong(), aT7(), aCN(), arr, res()
Dim soNgay&, NgayThuong&, soT7&, soCN&
Dim NgayLV&, lvCH&, lvT7&, NuaNgay#
Dim sRow&, i&, j&, k&, k2&, k3&, N&, M&
Randomize
soNgay = DateAdd("m", 1, Range("E3")) - Range("E3")
aNgay = Range("E3").Resize(, soNgay)
sArr = Range("AJ7:AN" & Range("B1000").End(xlUp).Row).Value
sRow = UBound(sArr)
ReDim res(1 To sRow + 1, 1 To 31)
ReDim aThuong(1 To soNgay)
ReDim aT7(1 To 10): ReDim aCN(1 To 10)
For j = 1 To soNgay
res(sRow + 1, j) = Weekday(aNgay(1, j), vbMonday)
If res(sRow + 1, j) = 7 Then
soCN = soCN + 1 'So ngay CN
k = k + 1: aCN(k) = j
ElseIf res(sRow + 1, j) = 6 Then
soT7 = soT7 + 1 'So ngay Thu 7
k2 = k2 + 1: aT7(k2) = j
Else
k3 = k3 + 1: aThuong(k3) = j 'Mang ngay thuong
End If
Next j
For i = 1 To sRow
If sArr(i, 4) > soT7 Or sArr(i, 5) > soCN Then _
MsgBox ("So ngay nghi T7 hoac CN sai!"): Exit Sub
NgayThuong = soNgay - soT7 - soCN 'So ngay thuong
sArr(i, 4) = soT7 - sArr(i, 4) 'So ngay lam viec thu 7
sArr(i, 5) = soCN - sArr(i, 5) 'So ngay lam viec CN
sArr(i, 1) = sArr(i, 1) - sArr(i, 4) - sArr(i, 5)
NuaNgay = NgayThuong - sArr(i, 1) - sArr(i, 2) - sArr(i, 3) 'So ngay thuong lam nua ngay
If NuaNgay < 0 Then MsgBox ("So ngay Lam Viec va Nghi qua lon!"): Exit Sub
NgayLV = sArr(i, 1) - NuaNgay 'So ngay thuong lam 1 ngay
NuaNgay = NuaNgay * 2 'So ngay thuong lam nua ngay
'Ngay thuong
arr = UniqueRand(NgayThuong)
k = 0
Call AddRes(res, aThuong, arr, k, i, NgayLV, "X") '1 Ngay
Call AddRes(res, aThuong, arr, k, i, NuaNgay, "X/2") 'Nua ngay
Call AddRes(res, aThuong, arr, k, i, sArr(i, 2), "0") 'Nghi khong luong
Call AddRes(res, aThuong, arr, k, i, sArr(i, 3), "L") 'Nghi co luong
'Thu 7
k = 0
N = Int(sArr(i, 4))
M = Int(sArr(i, 4) + 0.5)
arr = UniqueRand(soT7)
Call AddRes(res, aT7, arr, k, i, N, "X") '1 ngay
Call AddRes(res, aT7, arr, k, i, M - N, "X/2") 'Nua ngay
'Chu nhat
k = 0
N = Int(sArr(i, 5))
M = Int(sArr(i, 5) + 0.5)
arr = UniqueRand(soCN)
Call AddRes(res, aCN, arr, k, i, N, "X") '1 ngay
Call AddRes(res, aCN, arr, k, i, M - N, "X/2") 'Nua ngay
Next i
Range("E7").Resize(sRow, 31) = res
End Sub
Private Sub AddRes(res, sArr, arr, k, i, ByVal sCol&, ByVal strRes$)
Dim j&
For j = 1 To sCol
k = k + 1
res(i, sArr(arr(k))) = strRes
Next j
End Sub
Function UniqueRand(ByVal N As Long) As Variant
Dim arr() As Long, i As Long, RndNum As Long, tmp As Long
ReDim arr(1 To N)
'Randomize
For i = 1 To N
RndNum = Int(N * Rnd() + 1)
If arr(RndNum) = 0 Then tmp = RndNum Else tmp = arr(RndNum)
If arr(N) = 0 Then arr(RndNum) = N Else arr(RndNum) = arr(N)
arr(N) = tmp
N = N - 1
Next i
UniqueRand = arr
End FunctionChà chà, gọn ơi là gọn anh ơi.
Em cảm ơn bác ạ! file chạy tốt rồi ạ
