Nhờ Sửa 3 code tô màu cho trường hợp thống kê, phát hiện,...các tiết học giống nhau (5 người xem)

coconga · 7/8/13

Tôi có 3 code rất ngắn gọn: trong file dữ liệu kích thước 30 dòng đã dùng từ lâu, nay có nhu cầu tăng số dòng lên 60 dòng, tôi loay hoay sửa rồi nhưng nó hoạt động không đúng theo ý muốn rất mong các cao thủ ra tay giúp đỡ. Mô tả tại sheet " XEP TKB"

1) Code Kiểm tra dạy 3 tiết/ trên 1 lớp/ 1buổi học---------------------Sub Kiem_tra_3T()
2) Code kiểm tra giáo viên dạy trống 2 tiết / 1 buổi học----------------Public Sub Trong_2_3T
3) Code kiểm tra giáo viên dạy từ tiết 1 đến tiết 5 / 1 buổi học---------Sub DayT1_T5
(3 code này chạy sai từ dòng 33 đến dòng 60)

---------
Rất mong chờ giúp đỡ của anh chị, rất cảm ơn

coconga · 7/8/13

Các bác ơi, Mong các bác giúp em với, em cảm ơn

coconga · 7/8/13

Các anh chị bây giờ đang họp nhóm ở đâu ta, không có ai giúp em hết vậy ta

sealand · 7/8/13

Thử Test Sub Kiem_tra_3T (Thấy bạn sốt ruột nên mới làm được vậy gửi vậy)
Mình có thay đổi cấu trúc và cú pháp cho gọn và bớt ô cần sử lý
(Bạn không nói rõ là kiểm tra 3T ở 1 lớp trong ngay, hay trên 3 T trong ngày. Mình tạm làm 3T trong ngày)

Mã:

Sub Kiem_tra_3T()
Application.ScreenUpdating = False
Dim dl As Range, myRg As Range, eR, eC
Set dl = Sheet4.[c3:AP62]
dl.Interior.ColorIndex = xlNone
For eR = 1 To dl.Rows.Count
For eC = 2 To dl.Columns.Count Step 2
Set myRg = dl.Cells(Int(eR / 5) + 1, 1).Resize(5, dl.Columns.Count)
If WorksheetFunction.CountIf(myRg, dl.Cells(eR, eC)) > 2 Then _
dl.Cells(eR, eC).Interior.ColorIndex = 8
               Next
               Next
Application.ScreenUpdating = True
End Sub

Cái này khó hay sao ta, không có ai giúp được em hết vậy ta

Lần sau đừng viết thế này, vì nếu không khó thì bạn đâu có hỏi? Anh em cũng tranh thủ giúp bạn chứ nhiều người biết mà chưa thu xếp được thời gian cũng bó tay thôi. Mọi người cố gắng giúp nhau nhưng bạn cũng kiên nhẫn 1 chút (Bạn còn làm trong ngành giáo dục thì càng phải vậy).

coconga · 8/8/13

sealand đã viết:
Thử Test Sub Kiem_tra_3T (Thấy bạn sốt ruột nên mới làm được vậy gửi vậy)
Mình có thay đổi cấu trúc và cú pháp cho gọn và bớt ô cần sử lý
(Bạn không nói rõ là kiểm tra 3T ở 1 lớp trong ngay, hay trên 3 T trong ngày. Mình tạm làm 3T trong ngày)

Mã:

Sub Kiem_tra_3T() Application.ScreenUpdating = False Dim dl As Range, myRg As Range, eR, eC Set dl = Sheet4.[c3:AP62] dl.Interior.ColorIndex = xlNone For eR = 1 To dl.Rows.Count For eC = 2 To dl.Columns.Count Step 2 Set myRg = dl.Cells(Int(eR / 5) + 1, 1).Resize(5, dl.Columns.Count) If WorksheetFunction.CountIf(myRg, dl.Cells(eR, eC)) > 2 Then _ dl.Cells(eR, eC).Interior.ColorIndex = 8 Next Next Application.ScreenUpdating = True End Sub

Lần sau đừng viết thế này, vì nếu không khó thì bạn đâu có hỏi? Anh em cũng tranh thủ giúp bạn chứ nhiều người biết mà chưa thu xếp được thời gian cũng bó tay thôi. Mọi người cố gắng giúp nhau nhưng bạn cũng kiên nhẫn 1 chút (Bạn còn làm trong ngành giáo dục thì càng phải vậy).

Vâng em rút kinh nghiệm, do sốt ruột mong anh chị thông cảm
Test Sub Kiem_tra_3T.............kiểm tra 3T / trên 1 lớp ah
Em cảm ơn

sealand · 8/8/13

Nếu trên 1 lớp thì Code như sau:

Mã:

Sub Kiem_tra_3T2()
Application.ScreenUpdating = False
Dim dl As Range, myRg As Range, eR, eC
Set dl = Sheet4.[c3:AP62]
dl.Interior.ColorIndex = xlNone
For eR = 1 To dl.Rows.Count
For eC = 2 To dl.Columns.Count Step 2
Set myRg = dl.Cells(Int((eR - 1) / 5) * 5 + 1, eC).Resize(5)
If WorksheetFunction.CountIf(myRg, dl.Cells(eR, eC)) = 3 Then _
dl.Cells(eR, eC).Interior.ColorIndex = 8
               Next:  Next
Application.ScreenUpdating = True
End Sub

Đồng thời các đoạn còn lại bạn cũng nêu yêu cầu cụ thể chứ đoán ý thế này nghe chừng không chuẩn.

coconga · 8/8/13

sealand đã viết:
Nếu trên 1 lớp thì Code như sau:

Mã:

Sub Kiem_tra_3T2() Application.ScreenUpdating = False Dim dl As Range, myRg As Range, eR, eC Set dl = Sheet4.[c3:AP62] dl.Interior.ColorIndex = xlNone For eR = 1 To dl.Rows.Count For eC = 2 To dl.Columns.Count Step 2 Set myRg = dl.Cells(Int((eR - 1) / 5) * 5 + 1, eC).Resize(5) If WorksheetFunction.CountIf(myRg, dl.Cells(eR, eC)) = 3 Then _ dl.Cells(eR, eC).Interior.ColorIndex = 8 Next: Next Application.ScreenUpdating = True End Sub

Đồng thời các đoạn còn lại bạn cũng nêu yêu cầu cụ thể chứ đoán ý thế này nghe chừng không chuẩn.

Sub Kiem_tra_3T2() Xét 1 GV dạy 3tiết /trên 1 lớp
Trúng ý rồi, Cảm ơn bạn CODE này chuẩn rồi Sealad ah

Sub DayT1_T5 :Sub này là xét "phát hiện" trên 1 buổi học của 1 GV

Public Sub Trong_2_3T : Sub này là xết 1 buuổi học của 1 GV dạy trống từ 2 tiết trở lên
--------
Em MONG muốn các CODE này khi chạy chỉ lấy thông tin dữ liệu ở sheet "XEP TKB" mà ko lấy lấy dữ liệu ở sheet khác
Em cảm ơn Sealad va các bạn cùng giúp đỡ

VetMini · 8/8/13

Code của bạn có cả chục modules, chưa kể code của sheets, mà không có một dòng chú thích nào cả. Dòm vào như một đám rừng, chả hiểu bạn muốn làm cái gì.
Công việc chưa chắc đã khó nhưng vì chả hiểu nổi code muốn làm cái gì thì làm sao biết tại code sai hay là tại giải thuật sai.

Một kỹ thuật khác để viết code cho dễ chỉnh sửa là dùng constants thay cho magic numbers (gú gô từ khoá "magic numbers" trong ngữ cảnh programming thì sẽ thấy những bài phê bình magic numbers)

Mã:

Sub Kiem_tra_3T()
[COLOR=#008000]' các constants dùng để định vùng dữ liệu
' về sau muốn thay đổi chỉ việc thay đổi các Const này
[/COLOR]Const SHNAME = "XEP TKB"
Const NUM_ROWS = 60[COLOR=#008000] ' số dòng[/COLOR]
Const DATA_ROW1 = "C3:AP3"[COLOR=#008000] ' dòng đầu tiên của dữ liệu[/COLOR]
Application.ScreenUpdating = False
Dim dl, x, I, J
Set dl = Sheets(SHNAME).Range(DATA_ROW1).Resize(NUM_ROWS)
[COLOR=#008000]' bắt đầu thực sự ở đây
[/COLOR]dl.Interior.ColorIndex = xlNone
....

Các con số như số 5 cũng nên đặt thành Const
Const TIET_TN = 5 ' tiết trong ngày

Cái chỗ kiểm tra 3 tiết, tuỳ theo ý nghĩa của vấn đề bạn đặt trọng tâm ở con sô nào.
Nếu trọng tâm là con số 2 thì viết > 2 như bạn là đúng.
Nhưng nếu trọng tâm là 3 thì phải viết >= 3
Vá đặt:
Const MX_TIET = 3 ' số tiết tối đa trong 1 lớp

sealand · 8/8/13

Đây là code Trong_2_3T

Mã:

Public Sub Trong_2_3T()
Application.ScreenUpdating = False
Dim dl As Range, myRg As Range, eR, eC
Set dl = Sheet4.[c3:AP62]
dl.Interior.ColorIndex = xlNone
For eR = 1 To dl.Rows.Count
For eC = 2 To dl.Columns.Count Step 2
Set myRg = dl.Cells(Int((eR - 1) / 5) * 5 + 1, 1).Resize(5, dl.Columns.Count)
If WorksheetFunction.CountIf(myRg, dl.Cells(eR, eC)) < 4 Then _
dl.Cells(eR, eC).Interior.ColorIndex = 8
               Next:               Next
Application.ScreenUpdating = True
End Sub

sealand · 8/8/13

Tiếp Sub Trong_1_5T

Public Sub Trong_1_5T()
Application.ScreenUpdating = False
Dim dl As Range, myRg As Range, eR, eC
Set dl = Sheet4.[c3:AP62]
dl.Interior.ColorIndex = xlNone
For eR = 1 To dl.Rows.Count
For eC = 2 To dl.Columns.Count Step 2
Set myRg = dl.Cells(Int((eR - 1) / 5) * 5 + 1, 1).Resize(5, dl.Columns.Count)
If WorksheetFunction.CountIf(myRg, dl.Cells(eR, eC)) =4 Then _
dl.Cells(eR, eC).Interior.ColorIndex = 8
Next: Next
Application.ScreenUpdating = True
End Sub

coconga · 8/8/13

sealand đã viết:

Đây là code Trong_2_3T

Mã:

Public Sub Trong_2_3T()
Application.ScreenUpdating = False
Dim dl As Range, myRg As Range, eR, eC
Set dl = Sheet4.[c3:AP62]
dl.Interior.ColorIndex = xlNone
For eR = 1 To dl.Rows.Count
For eC = 2 To dl.Columns.Count Step 2
Set myRg = dl.Cells(Int((eR - 1) / 5) * 5 + 1, 1).Resize(5, dl.Columns.Count)
If WorksheetFunction.CountIf(myRg, dl.Cells(eR, eC)) < 4 Then _
dl.Cells(eR, eC).Interior.ColorIndex = 8
               Next:               Next
Application.ScreenUpdating = True
End Sub

Cảm ơn Sealad, Sub này chỉ có 1 màu nên khả năng phát hiện là rất khó, mong Sealad và Anh chị cùng chia sẻ

coconga · 8/8/13

sealand đã viết:
Tiếp Sub Trong_1_5T

Public Sub Trong_1_5T()
Application.ScreenUpdating = False
Dim dl As Range, myRg As Range, eR, eC
Set dl = Sheet4.[c3:AP62]
dl.Interior.ColorIndex = xlNone
For eR = 1 To dl.Rows.Count
For eC = 2 To dl.Columns.Count Step 2
Set myRg = dl.Cells(Int((eR - 1) / 5) * 5 + 1, 1).Resize(5, dl.Columns.Count)
If WorksheetFunction.CountIf(myRg, dl.Cells(eR, eC)) =4 Then _
dl.Cells(eR, eC).Interior.ColorIndex = 8
Next: Next
Application.ScreenUpdating = True
End Sub

Sub Trong_1_5T : Nếu thấy 1 Gv có dạy từ tiết 1 đến tiết 5(với lưu ý:tiết 2,3,4 có thể là ko dạy hoặc có dạy) thì hiện màu thông báo
------
Vì nhiều GV nên rất cần mỗi GV một màu để dễ xử lí
Em cảm ơn Sealad và các anh chị cùng giúp

caico9x · 8/8/13

VetMini đã viết:
Code của bạn có cả chục modules, chưa kể code của sheets, mà không có một dòng chú thích nào cả. Dòm vào như một đám rừng, chả hiểu bạn muốn làm cái gì.
Công việc chưa chắc đã khó nhưng vì chả hiểu nổi code muốn làm cái gì thì làm sao biết tại code sai hay là tại giải thuật sai.

Em hiểu Co con ga mô tả nhưng không biết giúp như thế nào..hi..hi ...

Mã:
Một kỹ thuật khác để viết code cho dễ chỉnh sửa là dùng constants thay cho magic numbers (gú gô từ khoá "magic numbers" trong ngữ cảnh programming thì sẽ thấy những bài phê bình magic numbers)

Mã:

Sub Kiem_tra_3T() [COLOR=#008000]' các constants dùng để định vùng dữ liệu ' về sau muốn thay đổi chỉ việc thay đổi các Const này [/COLOR]Const SHNAME = "XEP TKB" Const NUM_ROWS = 60[COLOR=#008000] ' số dòng[/COLOR] Const DATA_ROW1 = "C3:AP3"[COLOR=#008000] ' dòng đầu tiên của dữ liệu[/COLOR] Application.ScreenUpdating = False Dim dl, x, I, J Set dl = Sheets(SHNAME).Range(DATA_ROW1).Resize(NUM_ROWS) [COLOR=#008000]' bắt đầu thực sự ở đây [/COLOR]dl.Interior.ColorIndex = xlNone ....

Các con số như số 5 cũng nên đặt thành Const
Const TIET_TN = 5 ' tiết trong ngày

Cái chỗ kiểm tra 3 tiết, tuỳ theo ý nghĩa của vấn đề bạn đặt trọng tâm ở con sô nào.
Nếu trọng tâm là con số 2 thì viết > 2 như bạn là đúng.
Nhưng nếu trọng tâm là 3 thì phải viết >= 3
Vá đặt:
Const MX_TIET = 3 ' số tiết tối đa trong 1 lớp

Bác VetMini phân tích nghe rất chuyên gia, logicvà thuận tiện cho người dùng muốn sửa đổi vùng dữ liệu, Bác cho topic này đôi chiêu
Em thấy bạn co con ga mô tả
Sub Kiem_tra_3T2() Xét 1 GV dạy 3tiết /trên 1 lớp

Sub DayT1_T5 :Sub này là xét "phát hiện" trên 1 buổi học của 1 GV

Public Sub Trong_2_3T : Sub này là xết 1 buuổi học của 1 GV dạy trống từ 2 tiết trở lên
muốn các CODE này khi chạy chỉ lấy thông tin dữ liệu ở sheet "XEP TKB" mà ko lấy lấy dữ liệu ở sheet khác
Kết quả mỗi GV, mỗi môn học một màu chỉ thị

coconga · 8/8/13

3 code ở #1 này chạy đúng từ C3:AP32; CHẠY sai từ C33:AP62
Mục đích là kết quả nhận được như ở vùng C3:AP32
Rất cảm ơn

concogia · 8/8/13

Câu 1
Một cách viết khác

Mã:

Public Sub KT3tiet()
Dim Vung, I, J, Kt, kK
Application.ScreenUpdating = False
Set Vung = [C3:Z62]
Vung.Interior.ColorIndex = xlNone
For I = 2 To Vung.Columns.Count Step 2
    For J = 1 To Vung.Rows.Count Step 5
        Set Kt = Vung(J, I).Resize(5)
        For kK = 1 To 5
            If Kt(kK) <> "" Then
                If Application.WorksheetFunction.CountIf(Kt, Kt(kK)) > 2 Then
                    Kt(kK).Interior.ColorIndex = 8
                End If
            End If
        Next kK
    Next J
Next I
Application.ScreenUpdating = False
End Sub

Câu 2 ( hình như vẫn đạt yêu cầu mà)

Mã:

Public Sub Trong_2_3T()
    Dim d, Vung, VungDo, I, J, jJ, Cll, M, mM, K, kK, Mg, iMau, Tach
    Application.ScreenUpdating = False
    Set d = CreateObject("scripting.dictionary")
    Set Vung = [D3:Z62]: iMau = 3
        For I = 1 To Vung.Rows.Count Step 5
            Set VungDo = Vung(I, 1).Resize(5, Vung.Columns.Count)
            VungDo.Interior.ColorIndex = xlNone
            ReDim Mg(1 To 60, 1 To 3)
                For J = 1 To 5
                    For K = 1 To VungDo.Columns.Count Step 2
                        If Not d.exists(VungDo(J, K).Value) Then
                            M = M + 1
                            d.Add VungDo(J, K).Value, M
                            Mg(M, 1) = Mg(M, 1) & " " & VungDo(J, K).Address
                            Mg(M, 2) = J
                        Else
                            mM = d.Item(VungDo(J, K).Value)
                            Mg(mM, 1) = Mg(mM, 1) & " " & VungDo(J, K).Address
                            Mg(mM, 3) = J - Mg(mM, 2)
                            Mg(mM, 2) = IIf(Mg(mM, 3) > 2, 0, J)
                        End If
                    Next K
                Next J
                        For jJ = 1 To M
                            If Mg(jJ, 3) > 2 Then
                                iMau = iMau + 1
                                Tach = Split(Trim(Mg(jJ, 1)))
                                    For kK = LBound(Tach) To UBound(Tach)
                                        Range(Tach(kK)).Interior.ColorIndex = iMau
                                    Next kK
                            End If
                        Next jJ
                        d.RemoveAll: M = 0
        Next I
End Sub

Câu 3: đây là code kiểm tra 2 bước. Nếu Gv có tiết 1 & tiết 5 thì kiểm tra tiếp 3 tiết còn lại ( cái này bạn giải thích không rõ dễ làm cho các bạn muốn giúp hiểu sai ý)

Mã:

Sub DayT1_T5()
    Dim Wf, VungDau, VungCuoi, I, iMau, J, K, M, d, MauCu
    Application.ScreenUpdating = False
    Set d = CreateObject("scripting.dictionary")
    Set Wf = Application.WorksheetFunction
    Set Vung = [D3:Z62]
    Vung.Interior.ColorIndex = xlNone
    iMau = 3
        For I = 1 To Vung.Rows.Count Step 5
            Set VungDau = Vung(I, 1).Resize(, Vung.Columns.Count)
            VungDau.Select
            Set VungCuoi = Vung(I + 4, 1).Resize(, Vung.Columns.Count)
            VungCuoi.Select
                For M = 1 To VungCuoi.Columns.Count Step 2
                    If Wf.CountIf(VungDau, VungCuoi(M)) Then
                        If Not d.exists(VungCuoi(M).Value) Then
                            iMau = iMau + 1
                            d.Add VungCuoi(M).Value, iMau
                            VungCuoi(M).Interior.ColorIndex = iMau
                                For J = 0 To 3
                                    If Wf.CountIf(VungDau.Offset(J), VungCuoi(M)) Then
                                        K = Wf.Match(VungCuoi(M), VungDau.Offset(J), 0)
                                        VungDau.Offset(J)(K).Interior.ColorIndex = iMau
                                    End If
                                Next J
                        Else
                            MauCu = d.Item(VungCuoi(M).Value)
                            VungCuoi(M).Interior.ColorIndex = MauCu
                            For J = 0 To 3
                                If Wf.CountIf(VungDau.Offset(J), VungCuoi(M)) Then
                                    K = Wf.Match(VungCuoi(M), VungDau.Offset(J), 0)
                                    VungDau.Offset(J)(K).Interior.ColorIndex = MauCu
                                End If
                                
                            Next J
                         End If
                    End If
                Next M
        Next I
   Application.ScreenUpdating = True
End Sub

Số lớp trong trường sẽ cố định từ đầu năm học, bạn chỉ cần khai báo vùng dữ liệu theo bảng XEP TKB của bạn là được
Híc, nhìn 2 code 2 & 3 thấy .........quen quen..............quá xá

sealand · 8/8/13

coconga đã viết:
3 code ở #1 này chạy đúng từ C3:AP32; CHẠY sai từ C33:AP62
Mục đích là kết quả nhận được như ở vùng C3:AP32
Rất cảm ơn

Rất có thể file của bạn còn ảnh hưởng của các sự kiện Change của WorkSheet, WorkBook chứ mình Test thấy ổn mà .
Bạn chỉ giùm 1 điểm sai của code Kiemtra_3T xem sao>

coconga · 8/8/13

concogia đã viết:
Câu 1

Mã:

Một cách viết, cách giúp đỡ rất chuyên gia cảm ơn Bác "cò" ..hihi...., cho phép em test thử

Số lớp trong trường sẽ cố định từ đầu năm học, bạn chỉ cần khai báo vùng dữ liệu theo bảng XEP TKB của bạn là được

Nhấp chuột vào đây để mở rộng...

Em chưa rõ cách khai báo Bác "Cò" ơi

Híc, nhìn 2 code 2 & 3 thấy .........quen quen..............quá xá

Nhấp chuột vào đây để mở rộng...

Cảm ơn bác rất nhiều nhiều
-----------
Muốn nhờ Bác concogia và các anh chị là
Bây giờ với 3 code này đem sang áp dụng cho trường hợp Bảng TKB giáo viên (chỉ có giáo viên) hoặc Bảng TKBmôn học(chỉ có tên môn học) thì sửa lại như thế nào????, mong các bạn giúp em.

coconga · 8/8/13

sealand đã viết:
Rất có thể file của bạn còn ảnh hưởng của các sự kiện Change của WorkSheet, WorkBook chứ mình Test thấy ổn mà .
Bạn chỉ giùm 1 điểm sai của code Kiemtra_3T xem sao>

Mã:

[/COLOR]Sub Kiem_tra_3T()
Application.ScreenUpdating = False
Dim dl, x, I, J
Set dl = [c3:AP62]
dl.Interior.ColorIndex = xlNone
For cot = 1 To dl.Columns.Count
x = 1
   For dong = 1 To dl.Rows.Count
         If Application.CountIf(Range(dl(x, cot), dl(x + 4, cot)), dl(dong, cot)) > 2 Then
            dl(dong, cot).Interior.ColorIndex = 8
               End If
      If dong = 5 Then x = 6
         If dong = 10 Then x = 11
            If dong = 15 Then x = 16
               If dong = 20 Then x = 21
                  If dong = 25 Then x = 26
   Next
Next
Application.ScreenUpdating = True
[COLOR=#000000]
[/COLOR][COLOR=#000000]

-------
X42=LINH HA; Z45=VÂN : TÔ MÀU SAI VÌ CÓ 1 TIẾT
Bác xem giúp em

sealand · 8/8/13

Mình không theo Code của bạn đâu vì nó có nhiều vấn đề quá.
Trong Code mình thêm phần ghi comment là số tiết để kiểm tra
Bạn Test giùm và chỉ chỗ sai trên file mình gửi nha

coconga · 8/8/13

sealand đã viết:
Mình không theo Code của bạn đâu vì nó có nhiều vấn đề quá.
Trong Code mình thêm phần ghi comment là số tiết để kiểm tra
Bạn Test giùm và chỉ chỗ sai trên file mình gửi nha

Vâng ah, cảm ơn sadlad để em Test thử, rồi thông báo với bạn sau nhé
Chúc bạn vui vui và hạnh phúc cùng gia đình

Nhờ Sửa 3 code tô màu cho trường hợp thống kê, phát hiện,...các tiết học giống nhau (5 người xem)

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

Thành viên chính thức

Thành viên chính thức

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Ăn cùng góc phố

Thành viên gạo cội

Thành viên gạo cội

Thành viên chính thức

Thành viên chính thức

Thành viên mới

Thành viên chính thức

Gội rồi mới Cạo

Thành viên gạo cội

Thành viên chính thức

Thành viên chính thức

Thành viên gạo cội

File đính kèm

Thành viên chính thức

Đếm ngược thời gian