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

Liên hệ QC

Người dùng đang xem chủ đề này

Excel365

Thành viên tích cực
Tham gia
29/10/10
Bài viết
865
Được thích
127
Giới tính
Nam
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
 

File đính kèm

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

File đính kèm

Upvote 0
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)

 
Lần chỉnh sửa cuối:
Upvote 0
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:
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
 
Upvote 0
Đú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)
..............

Kết quả nó sai.
 
Lần chỉnh sửa cuối:
Upvote 0
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]
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom