Đánh x ngẫu nhiên, theo điều kiện (1 người xem)

[Excel365]

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

 

[SA_DQ]

Bạn tạm đem cái này đi báo cáo láo được rồi:

 

[Excel365]

Bạn tạm đem cái này đi báo cáo láo được rồi:

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)

 

[do thi mai]

ban xem da dung y chua

 

[Excel365]

ban xem da dung y chua

Cám ơn bạn nhiều.
Nhưng chưa đúng ý của mình. số suất cơm không phải lấy bằng với số ngày công. Đánh x dựa trên số suất cơm ở cột G

 

[SA_DQ]

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

Đú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:

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

 

[Excel365]

Đú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:

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

 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)

..............

Kết quả nó sai.

 

[ChanhTQ@]

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ố

 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

 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]