Chuyển thời khóa biểu lớp sang TKB giáo viên? (2 người xem)

[vtv1]

Tôi đã có một bảng excel Thời khóa biểu (TKB) theo lớp gồm:
- 30 cột. Tên mỗi cột là một lớp (10A1, 10A2, ...)
- 30 dòng. Mỗi dòng là một tiết học trong một ngày (30 dòng = 5 tiết/ngày x 6 ngày)
- Giao điểm của mỗi dòng, cột tương ứng là tên môn học và tên giáo viên dạy (VD: Toán-Hằng; Văn-H.Liên). Lưu ý: một giáo viên có thể dạy nhiều môn.

TKB theo lớp rất phù hợp cho học sinh nhưng không thuận tiện đối với giáo viên.

Tôi cần chuyển bảng excell trên thành TKB giáo viên với cấu trúc:
- Tên mỗi cột ứng với các tiết học trong một ngày (30 cột = 5 tiết/ngày x 6 ngày)
- Tên mỗi dòng ứng với tên giáo viên (sẽ có khoảng 60 giáo viên)
- Giao điểm của mỗi dòng, cột tương ứng là tên của lớp học.
* Lưu ý: Một giáo viên có thể dạy nhiều môn nhưng TKB của GV này vẫn được trình bày trên một dòng. Vì tại một ô của TKB GV không thể có tên của 2 lớp học (tại một thời điểm không thể có 2 tiết dạy của 1 GV).

Rất mong các bạn giúp đỡ.

 

[BNTT]

Tôi đổi cấu trúc bảng được không? Cũng là góp ý với bạn.

1. Giữa 2 bảng TKB này, nên có cùng cấu trúc với nhau.
   
   Ví dụ, ở TKB Lớp, bạn đã xếp Thứ (2, 3, 4...) nằm ở cột bên trái, thì bên TKB Giáo viên, bạn cũng nên xếp như vậy (xem Sheet TKB1 trong file đính kèm). Hoặc, ở TKB Giáo viên, bạn đã xếp Thứ (2, 3, 4...) nằm ở hàng trên cùng, thì bên TKB Lớp, bạn cũng nên xếp như vậy (xem Sheet TKB2 trong file đính kèm). Vì xếp như vậy, rất dễ dò tìm.
   
   Cái của bạn, hai bảng có cấu trúc ngược nhau, nên làm công thức sẽ phức tạp. Và tôi nói thật, sửa lại cấu trúc bảng cho giống nhau, dễ hơn và nhanh hơn thiết lập một công thức cho 2 bảng có cấu trúc khác nhau.
   
   
2. Cũng với lý do trên, bạn không nên gom 2 môn cho một giáo viên, cho dù nhìn thì hay, nhưng thiết lập công thức cho Excel nó hiểu được, thì lại không đơn giản chút nào. Nếu 1 GV dạy 2 môn, bạn cứ để 2 hàng (hoặc 2 cột) gần nhau, mỗi hàng chứa một môn mà thôi.

Gửi bạn file tôi đã thiết kế lại (cho dễ làm) để tham khảo.

 

[DOSNET]

Gửi bạn cách làm của Dosnet, bạn xem file đính kèm nhé !

 

[BNTT]

Nhận xét cách làm của DOSNET tí xíu:

Cách đặt Name rất hay, tuy nhiên, lỡ mà người ta chèn thêm vài cột trước cái thời khóa biểu Lớp (trước cột A), thì Name này không chính xác nữa.

...INDIRECT("C"&COLUMNS('TKB Lop'!$E:IS)&":"&"E"&COLUMNS('TKB Lop'!$E:IS)),0))​

Bạn nên nghiên cứu lại cái INDIRECT này, đừng dùng trực tiếp "C" hay "E"...

 

[DOSNET]

Nhận xét cách làm của DOSNET tí xíu:

Cách đặt Name rất hay, tuy nhiên, lỡ mà người ta chèn thêm vài cột trước cái thời khóa biểu Lớp (trước cột A), thì Name này không chính xác nữa.

...INDIRECT("C"&COLUMNS('TKB Lop'!$E:IS)&":"&"E"&COLUMNS('TKB Lop'!$E:IS)),0))​

Bạn nên nghiên cứu lại cái INDIRECT này, đừng dùng trực tiếp "C" hay "E"...

Để tự động hóa công thức cho toàn bộ vùng tính và không phải thiết kế lại vùng dữ liệu, phải dùng hàm INDIRECT trong trường hợp này e nghĩ là không có phương pháp nào "động" cho vùng tham chiếu. Nếu chèn thêm cột sẽ hỏng ăn ngay !

 

[anhtuan1066]

Để tự động hóa công thức cho toàn bộ vùng tính và không phải thiết kế lại vùng dữ liệu, phải dùng hàm INDIRECT trong trường hợp này e nghĩ là không có phương pháp nào "động" cho vùng tham chiếu. Nếu chèn thêm cột sẽ hỏng ăn ngay !

Tôi nghĩ ko có gì là ko thể cả, tôi làm như sau:
1> Đặt name:

DL ='TKB Lop'!$C$3:$E$12

***Đặt con trỏ chuột tại I4 và thêm name VT

 VT =IF((DL=$H3&"-"&$G3)*(ROW(INDIRECT("1:"&ROWS(DL)))=5*(COUNTIF($I$3:F$3,F$3)-1)+F$3),TRANSPOSE(ROW(INDIRECT("1:"&COLUMNS(DL)))),"")

2> Công thức:

I4 =IF(COUNT(VT),INDEX(OFFSET(DL,-1,,1,),,MIN(VT)),"")

Giờ thì vô tư mà insert dòng cột nhé!
Nếu dử liệu thay đổi, ta chỉ cần sửa mỗi name DL mà thôi

 

[SA_DQ]

Hãy tham khảo VBA làm điều ấy như thế nào

Option Explicit
Sub DSGiaoVien()
 Const SoLop As Byte = 20:              Const pC As String = "-"
 Dim Jj As Byte, VTr As Byte, Tiet As Byte
 Dim RngTuan As Range, Clls As Range, RngDS As Range, sRng As Range
 Dim Mon As String, GVien As String, Lop As String
 
 With Sheets("GVien")
    Set RngDS = .Range(.[b4], .[b65500].End(xlUp))
 End With
 Sheets("Lop").Select
 For Jj = 1 To 7
    Set RngTuan = Sheets("Lop").Cells(3 + 5 * (Jj - 1), "C").Resize(5, SoLop)
    For Each Clls In RngTuan
        With Clls
            VTr = InStr(1, .Value, pC)
            If VTr > 0 Then
                GVien = Mid(.Value, VTr + 1)
                Mon = Left(.Value, VTr - 1)
                Lop = Cells(2, .Column)
                Tiet = Cells(.Row, "B")
                Set sRng = RngDS.Find(what:=GVien, LookIn:=xlFormulas, lookat:=xlWhole)
                If Not sRng Is Nothing Then
                    If sRng.Offset(, 1) <> Mon Then
                        Set sRng = RngDS.FindNext(sRng)
                    End If
                    sRng.Offset(, (Jj - 1) * 5 + Tiet + 1) = Lop
                End If
            End If
        End With
    Next Clls
 Next Jj
 Sheets("GVien").Select
End Sub

 

[DOSNET]

Bác SA sửa lại tý xíu vì ngày T2 tiết 1 luôn là chào cờ

 

[ndu96081631]

Option Explicit
Sub DSGiaoVien()
 Const pC As String = "-"
 Const SoLop As Byte = 20   'Đổi trị này ứng với số lớp trong trường'              
 Dim Jj As Byte, VTr As Byte, Tiet As Byte
 Dim RngTuan As Range, Clls As Range, RngDS As Range, sRng As Range
 Dim Mon As String, GVien As String, Lop As String
 
 With Sheets("GVien")
    Set RngDS = .Range(.[b4], .[b65500].End(xlUp))
 End With
 Sheets("Lop").Select
 For Jj = 1 To 7
    Set RngTuan = Sheets("Lop").Cells(3 + 5 * (Jj - 1), "C").Resize(5, SoLop)
    For Each Clls In RngTuan
        With Clls
            VTr = InStr(1, .Value, pC)
            If VTr > 0 Then
                GVien = Mid(.Value, VTr + 1)
                Mon = Left(.Value, VTr - 1)
                Lop = Cells(2, .Column)
                Tiet = Cells(.Row, "B")
                Set sRng = RngDS.Find(what:=GVien, LookIn:=xlFormulas, lookat:=xlWhole)
                If Not sRng Is Nothing And sRng.Offset(, 1) = Mon Then
                    sRng.Offset(, (Jj - 1) * 5 + Tiet) = Lop
                Else
                End If
            End If
        End With
    Next Clls
 Next Jj
End Sub

Hình như có sai sót...
Em nghĩ sửa lại:
sRng.Offset(, (Jj - 1) * 5 + Tiet) = Lop
thành
sRng.Offset(, (Jj - 1) * 5 + 1 + Tiet) = Lop
Tuy nhiên vẫn sai dòng cuối (chưa tìm ra nguyên nhân)

 

[SA_DQ]

Đúng là còn cần phải sửa nhiều! Cảm ơn các bạn nhiều!

Đã thay macro & file đính kèm!
Nhưng, nếu giáo viên được bố trí dạy trên 2 môn thì chưa đúng!

Xin lỗi vì đã làm phìền các bạn!​

Xin MOD/SMOD xóa bài này sau ngày, xin cảm ơn!

 

[anhtuan1066]

Bài trên tôi dùng công thức còn chưa hay lắm (toàn công thức mãng). Nay tôi sửa lại, dùng công thức thường:
1> Đặt name:

Rng =OFFSET(TKB_Lop!$C$2:$E$2,(COUNTIF(TKB_GV!$F$3:F$3,TKB_GV!F$3)-1)*5+TKB_GV!F$3,)

Và công thức:

=IF(COUNTIF(Rng,$E4&"-"&$D4),INDEX(TKB_Lop!$C$2:$E$2,,MATCH($E4&"-"&$D4,Rng,0)),"")

Chỉ là COUNTIF, MATCH, INDEX bình thường
Công thức này cũng đảm bảo dc sự toàn vẹn khi thêm dòng, thêm cột

 

[ndu96081631]

Đã thay macro & file đính kèm!
Nhưng, nếu giáo viên được bố trí dạy trên 2 môn thì chưa đúng!

Xin lỗi vì đã làm phìền các bạn!​

Xin MOD/SMOD xóa bài này sau ngày, xin cảm ơn!

Em vừa nghĩ ra cách khác, xin gữi lên đoạn code của em, dùng duy nhất 1 vòng lập:

Sub TKB_GV()
  Dim i As Long, Clls As Range
  On Error Resume Next
  Range("I4:R22").ClearContents
  For Each Clls In Range("I4:R22")
    i = i + 1
    With Range("C2:E2").Offset(((i - 1) Mod 10) + 1)
      With .Find(Cells(Clls.Row, "H") & "-" & Cells(Clls.Row, "G"))
        If Not .Cells Is Nothing Then Clls = Cells(2, .Column)
      End With
    End With
  Next
End Sub

 

[phamduylong]

Góp thêm bằng VBA:
Tôi tách TKB Lop và TKB GV ra 2 sheet độc lập để có thể thêm lớp mới bên phải.
- Có thể thêm, bớt giáo viêni, lớp.
- Giáo viên có thể dạy nhiều môn. Nếu dạy trên 1 môn thì trong TKB giáo viên có tên lớp và tên môn (ví dụ 10A3-VAN).
- Kiểm tra TKB Lop giáo viên có bị trùng giờ không. Những ô trùng chữ màu đỏ.

Sub TKBGVLOP()
Dim tkbGv As Worksheet, gVien As Range
Dim kTra As Long, ccLop As Long, rcLop As Long, stt As Long
Dim ccGv As Long, rcGv As Long, rGv As Long, cGv As Long, gvAddress As String
Dim ten As String, mon As String, lop As String
Application.ScreenUpdating = False
Set tkbGv = ThisWorkbook.Sheets("TKB GV")
tkbGv.Select
ccGv = tkbGv.Cells(3, 3).End(xlToRight).Column
rcGv = tkbGv.Cells(4, 1).End(xlDown).Row
Range(Cells(4, 3), Cells(rcGv, ccGv)).ClearContents
Sheets("TKB Lop").Select
Cells.Font.ColorIndex = 0
ccLop = Cells(2, 3).End(xlToRight).Column
rcLop = Cells(2, 3).End(xlDown).Row
Range(Cells(3, 3), Cells(rcLop, ccLop)).Select

For rGv = 4 To rcGv
  ten = tkbGv.Cells(rGv, 1)
  kTra = InStr(1, Trim(tkbGv.Cells(rGv, 2)), ",")
  With Selection
    Set gVien = .Find(ten, LookIn:=xlValues)
    If Not gVien Is Nothing Then
      gvAddress = gVien.Address
      Do
        gVien.Activate
        mon = Mid(gVien.Value, 1, InStr(1, gVien.Value, "-") - 1)
        lop = Cells(2, gVien.Column)
        If kTra Then
          tkbGv.Cells(rGv, gVien.Row) = lop & "-" & mon
        Else
          tkbGv.Cells(rGv, gVien.Row) = lop
        End If
        '======================
        'Kiem tra trung gio day
        stt = 0
        For cGv = 3 To ccLop
          If InStr(1, Cells(gVien.Row, cGv), gVien) > 0 Then stt = stt + 1
          If stt > 1 Then
            Union(gVien, Cells(gVien.Row, cGv)).Font.ColorIndex = 3
          End If
        Next
        '=====================
        Set gVien = .FindNext(gVien)
      Loop While Not gVien Is Nothing And gVien.Address <> gvAddress
    End If
  End With
Next
Cells(3, 1).Select
tkbGv.Select
Cells(2, 1).Select
End Sub

 

[boyxin]

Ở trường em thì em làm như thế này (vẫn có thể in TKB cho từng lớp, từng GV)​

 

[vtv1]

Cảm ơn các bạn đã giải quyết vấn đề chuyển TKB lớp sang TKB GV.

Để tự động hóa cao hơn việc tạo TKB GV tôi thiết nghĩ cần bổ sung hai mục tiêu sau:

-Nội dung cột Tên GV và cột Môn dạy cần tự động điền (trích lọc, tách, …, ghi) từ dữ liệu của TKB lớp mà không cần phải gõ vào nội dung của hai cột này.

-Tên giáo viên được sắp xếp theo tổ chuyên môn. Một tổ chuyên môn gồm nhiều môn dạy. VD: các GV được chia thành 6 tổ chuyên môn: Toán - Đại - Hình - Tin; Lý - KTCN; Hóa - Sinh - KTNN; Sử - Địa - GDCD; Văn; Anh - TD. Các GV trong cùng một tổ chuyên môn sẽ có TKB GV được thể hiện ở các dòng kề nhau.

Tôi rất mong nhận được được sự giúp đỡ của các bạn.