Sắp thời khóa biểu có điều kiện (1 người xem)

[xmenx56]

Mong các thành viên giúp dùm. Yêu cầu trong file đính kèm.

 

[ChanhTQ@]

(ó thể là câu sẽ hỏi đây là câu ngố nhứt trong ngày!

(/ậy một lớp trong tuần học mấy tiết vậy anh bạn?

 

[xmenx56]

(/ậy một lớp trong tuần học mấy tiết vậy anh bạn?

Câu hỏi của bác rất chính xác. (1 lớp/2 tiết/1 tuần).

 

[SA_DQ]

/-(ình như khỏi cần sự trợ thủ của VBA chi cho mệt, . . .

Mà là: Trường bạn có 80 lớp & 20 giáo viên, vậy cứ 1 giáo viên 4 lớp;

Theo thứ tự trong danh sách GV (giáo viên) cứ lẽ ta bố trí dạy từ thứ 3 cho đến thứ 6 & chẵn sẽ là thứ 4 đến T7
Học kỳ sau đổi lại & vậy là xong;

Còn cầu kì hơn thì chia làm 4 nhóm 5 GV/nhóm ; 2 GV theo fương án trên, 3 GV còn lại dạy 3 tiết trong ngày (2 ngày trong tuần thay fiên)

/(hoẻ chưa & dành thời gian làm việc khác sướng hơn!?!

 

[xmenx56]

Mà là: Trường bạn có 80 lớp & 20 giáo viên, vậy cứ 1 giáo viên 4 lớp;

Theo thứ tự trong danh sách GV (giáo viên) cứ lẽ ta bố trí dạy từ thứ 3 cho đến thứ 6 & chẵn sẽ là thứ 4 đến T7
Học kỳ sau đổi lại & vậy là xong;

Còn cầu kì hơn thì chia làm 4 nhóm 5 GV/nhóm ; 2 GV theo fương án trên, 3 GV còn lại dạy 3 tiết trong ngày (2 ngày trong tuần thay fiên)

/(hoẻ chưa & dành thời gian làm việc khác sướng hơn!?!

Mỗi năm số lượng lớp khác nhau, số lượng lớp và số lượng giáo viên trong file chỉ là dự trù vậy, mỗi khi muốn sắp TKB thì phải mời giáo viên lại hội họp, bàn bạc xây dựng làm mất thời gian, do đó có ý tưởng làm trên máy cho nó gon nhẹ, không phải hội họp, đưa ra cho GV thống nhất thế là xong. Mong bác hiểu cho.

 

[SA_DQ]

(hắc chờ đến nản rồi nhỉ?!

Mới tạm bố trí tiết đầu tuần thôi; Tiết cuối tuần có thể tiếp hay làm bằng tay (Nếu không kịp chờ)
/(iểm thử xem khớp chưa nha.

 

[SA_DQ]

Bổ sung câu lệnh xóa dữ liệu trong biến mảng sau khi gán vô TKB

Option Explicit
Sub gpeTKB()
 Dim Sh As Worksheet, Cls As Range, Rng As Range, Clls As Range, Cll As Range
 Dim Rws As Long, STT As Byte, Ch As Byte
 Dim SoLop As Byte, Cot As Byte, Hg As Byte, ChLe As Byte
 ReDim mLop(1 To 9) As String
 
 Set Sh = ThisWorkbook.Worksheets("TKB")
 Rws = Sh.[A65500].End(xlUp).Row + 9
 Union(Sh.[c5].Resize(Rws, 6), Sh.[k5].Resize(Rws, 6)).ClearContents
 
 Sheets("DaTa").Select
 For Each Clls In Range([b5], [b5].End(xlDown))
   Rws = Clls.Row
   Sh.Cells(3 * Rws - 10, "A").Resize(3).Value = Clls.Value
   Set Rng = Range(Cells(Rws, "C"), _
      Cells(Rws, "iu").End(xlToLeft)).SpecialCells(xlCellTypeConstants, 2)
   SoLop = Rng.Count
   For Each Cll In Rng
      STT = STT + 1
      mLop(STT) = Cells(4, Cll.Column).Value
   Next Cll
   STT = 0
   ChLe = IIf(SoLop Mod 2 = 0, 2, 3)
   For Cot = 1 To 3
      For Hg = 1 To ChLe
         STT = 1 + STT
         If Left(mLop(STT), 1) = "7" Or Left(mLop(STT), 1) = "8" Then
            Ch = 8
         Else
            Ch = 0
         End If
         Sh.Cells(3 * Rws - 10 + Hg - 1, "B").Offset(, Cot + Ch).Value = mLop(STT)
         mLop(STT) = ""             '<=|'
      Next Hg
      If STT >= SoLop Then Exit For
   Next Cot
   Sh.Cells(3 * Rws - 10, "H").Value = Rng.Count
   STT = 0
 Next Clls
 Sh.Select
End Sub