buithinhvan77
Thành viên thường trực




- Tham gia
- 18/8/10
- Bài viết
- 268
- Được thích
- 137
Dùng thử công thức sau:Các bạn GPE giúp mình tính tổng số tiết dạy của GV theo file đính kèm!
Mình dùng công thức đếm nhưng hơi củ chuối nên nhờ mọi ngời giúp!
=TRIM(RIGHT(SUBSTITUTE(AB7," ",REPT(" ",255)),255))
=SUMPRODUCT(($C$7:$N$24=AA7)*$C$30:$N$47)
1) Mình cũng đã dùng Sumproduct rồi nhưng lại không biết là trong vùng đk thứ hai: C$30:$N$47 không cần thỏa mãn điều kiện gì cả mà vẫn đếm được! Cảm ơn Bebo nhiều nhé!Dùng thử công thức sau:
Tách tên: AA7:
Số tiết dạy: X7:Mã:=TRIM(RIGHT(SUBSTITUTE(AB7," ",REPT(" ",255)),255))
Mã:=SUMPRODUCT(($C$7:$N$24=AA7)*$C$30:$N$47)
TKB của bạn phân công theo tên giáo viên-nên dùng mã giáo viên để tránh sự trùng tên
Khi đó mã GV sẽ nằm tại vị trí AA7.
Thử công thức trong sheet TKB_GV xem có sử dụng được không.1) Mình cũng đã dùng Sumproduct rồi nhưng lại không biết là trong vùng đk thứ hai: C$30:$N$47 không cần thỏa mãn điều kiện gì cả mà vẫn đếm được! Cảm ơn Bebo nhiều nhé!
2) Giờ mình muốn mọi người giúp thêm phần Lọc TKB GV với nhé!
Trong File mình đã ghi!
Cám ơn Ba tê nhiều nhé!Thử công thức trong sheet TKB_GV xem có sử dụng được không.
Xin nhờ mọi người, đặc biệt bạn Bate chuyên gia lĩnh vực TKB!Thử công thức trong sheet TKB_GV xem có sử dụng được không.
"đặc biệt bạn Bate chuyên gia lĩnh vực TKB!".Xin nhờ mọi người, đặc biệt bạn Bate chuyên gia lĩnh vực TKB!
1. Tại sao Macco tô màu và xóa màu của mình chạy rất chậm?
2. Nhờ điểu chỉnh giúp công thức phần TKB của GV
Public Sub xoa_mau()
Sheets("Xep TKB").[A6].Resize(30, Sheets("Xep TKB").[IV5].End(xlToRight).Column).Interior.ColorIndex = 0
End Sub
Bạn chỉnh $Z$5 lại thành cột thích hợp trong sheet Xep TKB, như của bạn bây giờ là AP5, dư 1 số cột cũng được mà.=IF(COUNTIF(Tiet;'TKB GV'!$F$4);INDEX(Tiet;;MATCH('TKB GV'!$F$4;Tiet;0)-1) &"-" & INDEX('XEP TKB'!$C$5:$Z$5;;MATCH('TKB GV'!$F$4;Tiet;0)-1);"")
Cám ơn Bate"đặc biệt bạn Bate chuyên gia lĩnh vực TKB!".
Hổng dám nhận chuyện này đâu nhé!
1. Không hiểu ý bạn muốn tô màu và xóa màu để làm gì nên không "rớ" được.
Sao các Code bạn viết đều là Function nhỉ?
Nếu chỉ là xóa màu các ô trong Bảng thì chỉ cần code này:
PHP:Public Sub xoa_mau() Sheets("Xep TKB").[A6].Resize(30, Sheets("Xep TKB").[IV5].End(xlToRight).Column).Interior.ColorIndex = 0 End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
xoa_mau
Cancel = True
End Sub
2. Các Name GVA,B,C...:
Bạn chỉnh $Z$5 lại thành cột thích hợp trong sheet Xep TKB, như của bạn bây giờ là AP5, dư 1 số cột cũng được mà.
Kích chuột phải tự động chạy trước đây bạn làm sao?Cám ơn Bate
Trích lọc TKB GV thì OK rồi. Nhưng doạn code xóa màu bằng cách Kích chuột phải chưa tự động chạy?
Vẫn phải bấm Run hoặc F5?
Lúc trước đoạn code cũ bấm chuột phải là tự xóa màu, nhưng chạy chậm quá! Giờ chỉnh giúp mình theo code mới đi!
Híc! "Oai hỏi" thiệt!Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
xoa_mau
Cancel = True
End Sub
Bạn cho giúp mình xem đoạn Code đó vào chỗ nào vì mình cho nhưng sai nên chạy vẫn bị nháy lâu lămmuốn nhanh nữa thì thêm đoạn
PHP:Application.ScreenUpdating = False
PHP:Application.ScreenUpdating = true
vào các code đã viết, chứ để màn hình nó nháy vừa mất thời gian, vừa chóng cả mặt
Bạn cho giúp mình xem đoạn Code đó vào chỗ nào vì mình cho nhưng sai nên chạy vẫn bị nháy lâu lăm
Sub Oval20848_Click()
Application.ScreenUpdating = False
Dim dl, x, i, j
Set dl = [c6:z35]
dl.Interior.ColorIndex = xlNone
For cot = 1 To dl.Columns.Count Step 2
x = 1
For dong = 1 To dl.Rows.Count
If dl(dong, cot) = "" Then dl(dong, cot).Interior.ColorIndex = 6
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
End Sub
Xin cảm ơn các bác đã giúp! Nhưng mong bạn Quang Hải và các bạn giúp thêm:Code này mình viết nên khi đọc code và so sánh dữ liệu trong file thì mình nghĩ nên sửa lại tí, vì code sẽ tô màu luôn cả tên giáo viên. Nếu thấy đúng thì sửa lại cho phù hợp (thêm code: step 2)
PHP:Sub Oval20848_Click() Application.ScreenUpdating = False Dim dl, x, i, j Set dl = [c6:z35] dl.Interior.ColorIndex = xlNone For cot = 1 To dl.Columns.Count Step 2 x = 1 For dong = 1 To dl.Rows.Count If dl(dong, cot) = "" Then dl(dong, cot).Interior.ColorIndex = 6 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 End Sub
Xin cảm ơn các bác đã giúp! Nhưng mong bạn Quang Hải và các bạn giúp thêm:
1. Trong đọan code lần sau lại không tô màu được tên GV dạy 3 T/lớp?
2. Mình muốn thêm đoạn code tô màu GV trống 2,3 T trong ngày ở tất cả các lớp dạy chứ không riêng trong 1 lớp như code lần 1 của bạn Hải!
Cảm ơn các bạn nhiều!
Tô màu hoài vậy ta???Được các bác Quang Hải ; Bate và Aviaiva giúp đỡ bảng Xếp TKB của em gần hoàn thành rồi. Còn một yêu cầu nữa về tô màu GV trống nhiều hơn 2 tiết, mong các bác giúp cho!
Xin cảm ơn trước!
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!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
Híc, té ra cái nàykhông dễ nuốt, nó làm mình đau đầu quá.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ình như trong......một buổi chứ nhỉtên các GV bị trống 2 hoặc 3T trong 1 ngày
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í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
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
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
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ư!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.
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!
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ô: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
* Việc thống kê tiết thừa thiếu: Ý bạn là sao? Dùng VBA hay tạo đường link?
Đúng ý mình rồi, cảm ơn bạn. Nhưng mỗi GV một màu thì dễ phân biệt hơn, có bác nào giúp em thêm với!à để cho dễ nhìn thôi, không có gì.
tô mầu t1,t5 (1 mầu, muốn nhiều mầu thì em chịu)
Đúng ý mình rồi, cảm ơn bạn. Nhưng mỗi GV một màu thì dễ phân biệt hơn, có bác nào giúp em thêm với!
Thích thì chìu, mỗi em một màu cho đẹp, hihiĐúng ý mình rồi, cảm ơn bạn. Nhưng mỗi GV một màu thì dễ phân biệt hơn, có bác nào giúp em thêm với!
Hi em biết ngay thế nào bác Cò cũng giúp em mà, thanh bác nhiều!Thích thì chìu, mỗi em một màu cho đẹp, hihi
Thân
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à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)
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