Nhờ các anh chị giúp em đánh x ngẫu nhiên theo điều kiện,
Điểm trong ngày > 0, thì đánh x. Nhưng Tổng số x = Tổng số suất cơm ở cột G
Trân trọng cảm ơn
Cám ơn anh nhiều.
Nhờ anh xem lại dùm em, chỗ Điểm trong ngày > 0, thì đánh x, ngược lại không đánh x. Ngày nào có đi làm mới chấm cơm
Trường hợp chỗ Lê Văn Tâm, ngày 13 không có đi làm, nhưng chạy code nó đánh x vô luôn (ý của em là sẽ không đánh x vào ngày này)
Đúng là còn thiếu các dòng lệnh (có đánh số)do chép chưa cẩn thận; Bạn lấy cái này chép đè lên:
PHP:
Option Explicit
Sub XuatCom()
Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range, Cll As Range
Dim Rws%, J%, Cm As Byte, W%
Sheets("Com").Select
Set Sh = ThisWorkbook.Worksheets("Cong")
Set Rng = Sh.Range(Sh.[A6], Sh.[A65500].End(xlUp))
Rws = [c7].CurrentRegion.Rows.Count
[f7].Resize(Rws, 31).ClearContents
Application.ScreenUpdating = False
For Each Cls In Range([a7], [a9999].End(xlUp))
If Cls.Value <> "" Then
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
If sRng.Offset(, 4).Value = Cls.Offset(, 4).Value Then
For Each Cll In Sh.Cells(sRng.Row, "f").Resize(, 31)
If Cll.Value > 0 Then
Cells(Cls.Row, Cll.Column).Value = "X"
End If
Next Cll
Else
Cm = Cls.Offset(, 4).Value
If Cm > 0 Then
If sRng.Row Mod 2 = 0 Then
For J = 6 To 37
If Sh.Cells(sRng.Row, J).Value > 0 Then
Cm = Cm - 1
Cells(Cls.Row, J).Value = "X"
If Cm = 0 Then Exit For
End If
Next J
Else
For J = 36 To 5 Step -1
32 If Sh.Cells(sRng.Row, J).Value > 0 Then
Cm = Cm - 1
Cells(Cls.Row, J).Value = "X"
If Cm = 0 Then Exit For
36 End If
Next J
End If
End If
End If
End If
End If
Next Cls
Application.ScreenUpdating = True
End Sub
Đúng là còn thiếu các dòng lệnh (có đánh số)do chép chưa cẩn thận; Bạn lấy cái này chép đè lên:
PHP:
Option Explicit
Sub XuatCom()
Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range, Cll As Range
Dim Rws%, J%, Cm As Byte, W%
Sheets("Com").Select
Set Sh = ThisWorkbook.Worksheets("Cong")
Set Rng = Sh.Range(Sh.[A6], Sh.[A65500].End(xlUp))
Rws = [c7].CurrentRegion.Rows.Count
[f7].Resize(Rws, 31).ClearContents
Application.ScreenUpdating = False
For Each Cls In Range([a7], [a9999].End(xlUp))
If Cls.Value <> "" Then
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
If sRng.Offset(, 4).Value = Cls.Offset(, 4).Value Then
For Each Cll In Sh.Cells(sRng.Row, "f").Resize(, 31)
If Cll.Value > 0 Then
Cells(Cls.Row, Cll.Column).Value = "X"
End If
Next Cll
Else
Cm = Cls.Offset(, 4).Value
If Cm > 0 Then
If sRng.Row Mod 2 = 0 Then
For J = 6 To 37
If Sh.Cells(sRng.Row, J).Value > 0 Then
Cm = Cm - 1
Cells(Cls.Row, J).Value = "X"
If Cm = 0 Then Exit For
End If
Next J
Else
For J = 36 To 5 Step -1
32 If Sh.Cells(sRng.Row, J).Value > 0 Then
Cm = Cm - 1
Cells(Cls.Row, J).Value = "X"
If Cm = 0 Then Exit For
36 End If
Next J
End If
End If
End If
End If
End If
Next Cls
Application.ScreenUpdating = True
End Sub
Mình tìm hiểu code của bạn nhưng có 1 số chỗ không hiểu. nhờ bạn có thể giải thích ý nghia các dòng lệnh giúp mình nhe.
Cám ơn bạn nhiều
Ps: Em chèn bên bảng Công thêm 1 cột và sữa thành
Mã:
If sRng.Offset(, [COLOR=#ff0000]5[/COLOR]).Value = Cls.Offset(, 4).Value Then
For Each Cll In Sh.Cells(sRng.Row, "[COLOR=#ff0000]g[/COLOR]").Resize(, 31)
Khai báo các biến cần xài trong chương trình; Thêm nữa, dòng đầu là các biến đối tượng, dòng sau tạm gọi là các biến chứa số
Mã:
Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range, Cll As Range
Dim Rws%, J%, Cm As Byte, W%, Tmr#
Gồm 2 dòng lệnh viết chung trên 1 dòng; Lệnh đầu là chọn trang tính thao tác; Dòng sau: Gán thời điểm hiện tại vô biến
PHP:
Sheets("Com").Select: Tmr = Timer()
Gán trang tính có tên 'Cong' vô biến đối tượng: Set Sh = ThisWorkbook.Worksheets("Cong")
Gán 1 vùng có dữ liệu cột [A] vô biến đối tượng: Set Rng = Sh.Range(Sh.[A6], Sh.[A65500].End(xlUp))
Lấy số dòng của vùng dữ liệu liên tục quanh ô C7 gán vô biến: Rws = [c7].CurrentRegion.Rows.Count Xóa dữ liệu do lần chạy macro lần trước:
[f7].Resize(Rws, 31).ClearContents Không cho cập nhật màn hình:
Application.ScreenUpdating = False Khởi động bộ tạo số ảo:
Randomize Tạo vòng lặp duyệt các ô của cột [A] có dữ liệu; Vòng lặp này kết thúc khi gặp Next Cls
For Each Cls In Range([a7], [a9999].End(xlUp)) ĐKiện: Nếu ô đang duyệt có dữ liệu; Cái ni để giảm động tác thừa:
If Cls.Value <> "" Then Tiến hành fương thức tìm kiếm theo trị có trong ô duyệt; vùng tìm chứa trong biến Rng:
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole) ĐKiện nếu tìm thấy:
If Not sRng Is Nothing Then ĐKiện nếu trị trong ô cách 4 về fía fải của ô tìm thấy bằng với trị trong ô cách 4 về fía fải:
1 If sRng.Offset(, 4).Value = Cls.Offset(, 4).Value Then Tạo vòng lặp duyệt các ô bắt đầu từ cột [F] cùng hàng với ô tìm thấy fát triển về fía fải 31 cột.
For Each Cll In Sh.Cells(sRng.Row, "f").Resize(, 31) ĐK nếu ô đang duyệt có số liệu:
If Cll.Value > 0 Then Ghi 'X' lên ô cùng dòng với ô đang duyệt (Cls) & có cột trùng với cột của vùng ghi công (Cll):
Cells(Cls.Row, Cll.Column).Value = "X"
[thongbao]
End If 'Kết thúc ĐK'
Next Cll 'Chuyển sang duyệt ô Cll kế tiếp'
Else 'Nếu không thỏa ĐK ở 1, thì thực hiện các lệnh sau'
Cm = Cls.Offset(, 4).Value 'Lấy dữ liệu của ô cách ô đang duyệt 4 ô về fía fải cho vô biến'
If Cm > 0 Then 'ĐK nếu trị này lớn hơn 0'
W = 8 + 9 * Rnd() \ 1 'Tạo 1 số ngẫu nhiên giữa 8 & 17'
If W Mod 2 = 0 Then 'Nếu trị này là số chẵn'
For J = 6 To 37 'Thực hiện vòng lặp từ cột thứ 6 về cuối'
If Sh.Cells(sRng.Row, J).Value > 0 Then 'Nếu ô có dòng trùng với ô tìm thấy & cột trùng với J, thì'
Cm = Cm - 1 'Trừ 1 cho biến đếm (cong)'
Cells(Cls.Row, J).Value = "X" 'Đánh dấu "X" vô ô
If Cm = 0 Then Exit For 'ĐK thoát vòng lặp'
End If
Next J
Else 'Nếu ngược lại thì duyệt từ cuối lên đầu'
For J = 36 To 5 Step -1
32 If Sh.Cells(sRng.Row, J).Value > 0 Then
Cm = Cm - 1
Cells(Cls.Row, J).Value = "X"
If Cm = 0 Then Exit For
36 End If
Next J
End If
End If
End If
End If
End If
Next Cls
Application.ScreenUpdating = True 'Cho fép ghi kết quả'
[Al4].Value = Timer() - Tmr
[/thongbao]