Giúp đỡ tính tổng số tiết dạy của GV theo PCCM

Liên hệ QC
Tô màu hoài vậy ta???
PHP:
Sub to_mau_nua()
Application.ScreenUpdating = False
Dim dl, x, cot, dong
Set dl = [c6:z35]
dl.Interior.ColorIndex = xlNone
For cot = 2 To dl.Columns.Count Step 2
  x = 1
    For dong = 1 To dl.Rows.Count
      If Application.CountIf(Range(dl(x, cot), dl(x + 4, dl.Columns.Count)), dl(dong, cot)) < 4 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
End Sub
Cảm ơn bac Hải quan tâm nhưng Code rồi bác Test hộ em chưa mà đúng là tô màu hoài thật!
Ý em là chỉ tô màu tên các GV bị trống 2 hoặc 3T trong 1 ngày thôi mà. Sao Code rồi tô màu chưa trúng ý em, mong các bác chỉnh giúp
 
Cảm ơn bac Hải quan tâm nhưng Code rồi bác Test hộ em chưa mà đúng là tô màu hoài thật!
Ý em là chỉ tô màu tên các GV bị trống 2 hoặc 3T trong 1 ngày thôi mà. Sao Code rồi tô màu chưa trúng ý em, mong các bác chỉnh giúp
Híc, té ra cái nàykhông dễ nuốt, nó làm mình đau đầu quá.
tên các GV bị trống 2 hoặc 3T trong 1 ngày
Hình như trong......một buổi chứ nhỉ
Muốn kiểm tra cái này sao bạn không đưa về TKB cá nhân sẽ dễ nhìn & .....dễ làm hơn ( khỏi code, dùng CF nhưng dở một cái là chỉ kiểm tra mỗi lần được một Gv thôi. )
Híc, cái bảng nhiều màu thật, nhìn chóng mặt quá
Thân
 

File đính kèm

  • TKB so 1 (19-8-2012) - Copy.rar
    70.7 KB · Đọc: 41
Híc, té ra cái nàykhông dễ nuốt, nó làm mình đau đầu quá.

Hình như trong......một buổi chứ nhỉ
Muốn kiểm tra cái này sao bạn không đưa về TKB cá nhân sẽ dễ nhìn & .....dễ làm hơn ( khỏi code, dùng CF nhưng dở một cái là chỉ kiểm tra mỗi lần được một Gv thôi. )
Híc, cái bảng nhiều màu thật, nhìn chóng mặt quá
Thân
Thật quá đúng ý em rồi bác Cò ơi! Bác giúp em nhiều quá rồi, đa tạ, đa tạ, đa tạ .....!
 
hì không phải tự sướng, nhưng file hỗ trợ của em vẫn có vẻ dễ nhìn hơn của bác buithinhvan, nhưng có lẽ do thói quen, hoặc do xuất phát điểm tiếp xúc với cách bố trí TKB giáo viên, học sinh trên một bảng mà hầu hết các trường đều sài theo kiểu của bac buithinhvan %#^#$.

Có lần thanh tra sở về thanh tra toàn diện trường em, họ đòi nộp TKB cho họ,

Sau khi nộp, họ nhìn TKB

phán một câu:

có thế này thôi á!

^^!
 
Lần chỉnh sửa cuối:
Vẫn giữ nguyên các câu lệnh của bạn cho sự kiện before-doubleclick trong sheet Xep TKB nhen.
Mình chỉ giúp bạn thay đổi 2 functions (lẽ ra là sub) trong MODULE 1 để giúp cho việc xoá màu của bạn hoạt động nhanh hơn. File đính kèm cho bạn

--------
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
kt = khoi_tao()
m = xoa_mau() 'function gốc của bạn làm chậm nè
v = kt_tkb() 'function gốc của bạn làm chậm nè
Cancel = True
End Sub
-------------

Mình chỉ giúp bạn thay đổi 2 functions (lẽ ra là sub) trong MODULE 1 để giúp cho việc xoá màu của bạn hoạt động nhanh hơn:

1. function xoa_mau()
Mã:
Public Function xoa_mau()
'Dat ten de lam xong con quay lai
 ActiveWorkbook.Names.Add Name:="vitri", RefersToR1C1:=ActiveCell
' Xoa mau trong TKB
'[MOCS]: phần này làm function chậm nè
[COLOR=#ff0000]'Range(odau_kt).Select
' For j = 0 To stiet
'     For i = 0 To slop * 2
'         Set otiep = Selection.Offset(j, i)
'          otiep(1).Interior.ColorIndex = xlNone
'          otiep.ClearComments
'      Next
' Next[/COLOR]
[COLOR=#0000cd]'[MOCS]: mình thay bằng câu lệnh này. Những phần còn lại của bạn mình không thay đổi gì hết vì không biết bạn còn dùng nó ở chổ khác hay không[/COLOR]
[B]Range("C6:AP35").Interior.ColorIndex = xlNone[/B]

 Application.Goto Reference:="vitri"
 
End Function

2. function kt_tkb: tron function này bạn có 1 câu lệnh nhằm xóa màu ô nếu có.

otiep(1).Interior.ColorIndex = xlNone 'xoa mau o neu co

Câu lệnh này lúc nào cũng thực hiện dù ô đó đã là xlNone rồi. Nên mình thêm dòng if vô để tránh thực hiện vô ích nhé.


Public Function kt_tkb()
cot = 0
'Dat ten de lam xong con quay lai
ActiveWorkbook.Names.Add Name:="vitri", RefersToR1C1:=ActiveCell
'--- het phan dat ten

Range(odau_kt).Select
Dim v
ActiveCell.Offset(0, 1).Select
' Duyet theo tung dong. Het mot vong j la het 1 dong
For j = 0 To stiet
dongst = "$"
For i = 0 To slop - 1
Set otiep = Selection.Offset(j, 2 * i)
'[MOCS] Mình thêm vô check điều kiện, sẽ làm cho function chạy nhanh hơn.
If (otiep(1).Interior.ColorIndex <> -4142) Then
otiep(1).Interior.ColorIndex = xlNone 'xoa mau o neu co
End If
' lay ra duoc 1 dong
TenGV = Trim(otiep(1))
If TenGV <> "" Then
If (InStr(dongst, "$" + TenGV + "$") = 0) Then
dongst = dongst + TenGV + "$"
Else
' To mau den o trung tiet
For dgto = 0 To i
Set otiep = Selection.Offset(j, 2 * dgto)
If TenGV = Trim(otiep(1)) Then
otiep(1).Interior.ColorIndex = 3
End If
Next
End If
End If
Next
Next
Application.Goto Reference:="vitri"
End Function
 

File đính kèm

  • TKB 1 Duong noi 6 -7.rar
    59.3 KB · Đọc: 23
Thân gửi Bác cò và các bác trên diễn đàn! Em đang hoàn thiện Fiel Xếp TKB của trường và muốn chia sẻ cho các bạn đồng nghiệp, một số đoạn code được các bác gjups đỡ rất đúng ý; nhưng còn một vài ý tưởng nữa chưa xong, mong các bác giúp cho đoạn Code Tô màu các GV phải dạy từ T1 - T5 , yêu cầu em đã ghi rõ trong File!
------------------
Thanh các bác trước!
 

File đính kèm

  • TKB so 1 (25-8-2012).rar
    71.4 KB · Đọc: 22
Bạn Thinh Van ơi , sao thay đổi môn học ở sheet pccm thi code bị lỗi , bạn có cách gì khắc phục trường hợp này , trong trường hợp thêm bớt một số môn học mà không bị lỗi.
 
Bạn Thinh Van ơi , sao thay đổi môn học ở sheet pccm thi code bị lỗi , bạn có cách gì khắc phục trường hợp này , trong trường hợp thêm bớt một số môn học mà không bị lỗi.
Nếu thay đổi tên môn học ở Sheet PCCM thì ở Sheet Xep TKB bạn phải thay toàn bộ tên các môn học đã thay ở Sheet PCCM, sau đó Code lại chạy vô tư!
VD: Ở Sheet PCCM có môn TC nhưng bạn sửa lại TC thành Tin
=> Bạn phải sửa tất các môn TC ở Sheet Xep TKB thành Tin (Hoặc xóa đi)
 
Thân gửi Bác cò và các bác trên diễn đàn! Em đang hoàn thiện Fiel Xếp TKB của trường và muốn chia sẻ cho các bạn đồng nghiệp, một số đoạn code được các bác gjups đỡ rất đúng ý; nhưng còn một vài ý tưởng nữa chưa xong, mong các bác giúp cho đoạn Code Tô màu các GV phải dạy từ T1 - T5 , yêu cầu em đã ghi rõ trong File!
------------------
Thanh các bác trước!


Một vài góp ý nhỏ:

- sau khi lựa chọn môn => tên giáo viên sẽ xuất hiện cái này có lẽ hơi ngược vì thông thường nhà trường lấy nguyện vọng TKB của giáo viên chứ không lấy nguyện vọng TKB của học sinh em nghĩ bác nên đổi lại cho chọn tên giáo viên khi đó môn tương ứng sẽ tự biến đổi theo.

- Việc kiểm tra số tiết thừa thiếu bác nên để trong 1 sheet như thế tiện quan sát hơn hoặc tống thẳng vào cái comment, TKB của bác đã hoàn thiện thì một vài vi chỉnh không có gì phải bàn, nếu bắt đầu từ đầu mỗi lần kiểm tra cứ phải chuyển sheet liên tục cũng bất tiện.


Cái bác cần (tô mầu đối với GV dạy từ T1 ->T5) Không biết đã đúng ý bác chưa bác download file đính kèm
 

File đính kèm

  • TKB (25-8-2012).rar
    69.4 KB · Đọc: 20
Lần chỉnh sửa cuối:
Một vài góp ý nhỏ:

- sau khi lựa chọn môn => tên giáo viên sẽ xuất hiện cái này có lẽ hơi ngược vì thông thường nhà trường lấy nguyện vọng TKB của giáo viên chứ không lấy nguyện vọng TKB của học sinh em nghĩ bác nên đổi lại cho chọn tên giáo viên khi đó môn tương ứng sẽ tự biến đổi theo.

- Việc kiểm tra số tiết thừa thiếu bác nên để trong 1 sheet như thế tiện quan sát hơn hoặc tống thẳng vào cái comment, TKB của bác đã hoàn thiện thì một vài vi chỉnh không có gì phải bàn, nếu bắt đầu từ đầu mỗi lần kiểm tra cứ phải chuyển sheet liên tục cũng bất tiện.


Cái bác cần (tô mầu đối với GV dạy từ T1 ->T5) Không biết đã đúng ý bác chưa bác download file đính kèm
Cảm ơn bạn Aviaiva, Code của bạn chạy được rồi nhưng có lẽ do mình mô tả chưa kỹ nên bạn có thể chỉnh lại giúp đoạn code đó là: Tô màu GV phải dạy T1 và T5 (Tức là có thể trống tiết, không nhất thiết phải dạy cả 5T) cụ thể muốn tô:
VD: GV Vân ngày thứ 2 có T1,2,3 và T5
GV Thịnh ngày thứ 7 có T1,4 và T5
Mình không biết nhiều về VBA, chỉ biết vài Macco đơn giản nên chỉnh lại Cocde của bạn mà nó cử nhảy lung tung
-------------------------
* Còn về việc nhập môn học => tên GV hay nhập nguyện vọng GV => môn học trên TKB (Cái này của mình ngược với cách bố trí xếp TKB của bạn) là do đặc điểm GV của trường mình: 1 GV có thể dạy tới 3 môn; nếu nhập nguyện vọng thì sẽ bị có những môn không muốn dạy T5 như TD chẳng hạn mình không hạn chế được ....
Và có lẽ do quen rồi.. hj
Với lại TKB của các lớp thì năm nào cũng vậy thường cố định số môn, số tiết; vậy khi xếp một TKB mới mình chỉ cần thay đổi tên GV ở PCCM là tự Xếp TKB đã có tên GV theo môn không cần xếp từ đầu (tất nhiên sẽ có trùng tiết mình chỉ cần điều chỉnh khoảng 30' hoặc 1 tiếng nữa là OK!)
* Việc thống kê tiết thừa thiếu: Ý bạn là sao? Dùng VBA hay tạo đường link? Mình chưa rõ, giúp mình luôn nhé!
Thank bạn nhiều!
 
Lần chỉnh sửa cuối:
Thích thì chìu, mỗi em một màu cho đẹp, hihi
Thân
Hi em biết ngay thế nào bác Cò cũng giúp em mà, thanh bác nhiều!
Nhưng bác ơi, tên một giáo viên ở 2 ngày đều có 5 tiết (GV Hạnh) thì lại mang 2 màu hả bác?
Giá mà bác giúp em thêm các cô như thế chỉ mang 1 màu thì tốt quá (Cho nó đỡ lòe loẹt, hj)
 
Hi em biết ngay thế nào bác Cò cũng giúp em mà, thanh bác nhiều!
Nhưng bác ơi, tên một giáo viên ở 2 ngày đều có 5 tiết (GV Hạnh) thì lại mang 2 màu hả bác?
Giá mà bác giúp em thêm các cô như thế chỉ mang 1 màu thì tốt quá (Cho nó đỡ lòe loẹt, hj)
cái zụ này trong yêu cầu đâu có nói tới nó, bi giờ mới....xuất hiện mà
Bạn chép đè code này lên code cũ giúp mình nhé
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 = [D6:Z35]
    Vung.Interior.ColorIndex = xlNone
    iMau = 3
        For I = 1 To Vung.Rows.Count Step 5
            Set VungDau = Vung(I, 1).Resize(, Vung.Columns.Count)
            Set VungCuoi = Vung(I + 4, 1).Resize(, Vung.Columns.Count)
                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
Thân
 
Hay quá rồi bác à! Sau vụ này không em nào còn bị sai sót nữa đâu, kiểm tra được hết ráo rùi!
 
mấy ac ơi giúp em lấy dữ liệu từ PCCM sang PCGD sử dụng công thức hay code cũng được em cám ơn
 

File đính kèm

  • TKB 1_0.xlsx
    110.2 KB · Đọc: 13
Web KT
Back
Top Bottom