sao mình lấy file về, chọn giáo viên, nhập ngày nghỉ thì không tự động cập nhật các tiết theo thứ, thời khóa biểu và lại file mình gửi lên có nút sort ngyaf tháng giờ mất tiêu rôi,
cảm ơn bạn , để mình thử xem nhé
mình hiểu ý bạn rồi, thay vì việc lâu nay mình gõ ngày tháng vào cột D thì tự động sẽ thêm thứ vào cột C. mình đã chép code đó vào và nó chạy được. cảm ơn bạn nhé. nếu có thể thì mình nhờ bạn chỉnh lại code một chút để nó tự động cập nhật ngày và thứ giống như file mình đã gửi đính kèm được không?cảm ơn bạn
cảm ơn bạn,mình đã thử nhưng sao code chạy không đúng. vì khi chuyển code như vậy sẽ ảnh hưởng đến sheet LỌC theo tên gv và lọc TỪ NGÀY ĐẾN NGÀY nữa. ý mình muốn phương thức nhập giống như file mình gửi #1 ấy. bạn có thể xem lại code đó và sửa code để cập nhật các tiết có MÀU ĐỎ thành các tiết * thôi. cảm ơn bạn rất nhiều nhé
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Lop As Range, a(), R As Range, TK As Range, H As Integer, W As Integer, _
x As Integer, y As Integer, z As Integer, d As Integer, ddd, Day As String
ddd = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")
Set Lop = Sheets("TKB").[C3:AD3]
Set TK = Sheets("TKB").[C4:AD13]
H = TK.Rows.Count
W = TK.Columns.Count
ReDim a(1 To 1, 1 To H - 1)
If Not Intersect(Target, Union([B:B], [D:D])) Is Nothing Then
If Target.Count = 1 Then
Day = WorksheetFunction.Text(Target.Offset(, 4 - Target.Column), "[$-0]ddd")
If Target.Column = 2 Then z = 2 Else z = -2
d = WorksheetFunction.Match(Day, ddd, 0)
[COLOR=#ff0000]If Not IsDate(Target.Offset(, 4 - Target.Column)) Then Cells(Target.Row, 3) = "" Else Cells(Target.Row, 3) = d
If Target.Offset(, 2 - Target.Column) = "" Then Range("C" & Target.Row).Resize(, H + 1) = ""
[/COLOR] If Target <> "" And Target.Offset(, z) <> "" And d >= 2 Then
Set R = TK.Offset((d - 2) * H)
For x = 1 To H - 1
For y = 1 To W
If UCase(R(x, y)) = UCase(Target.Offset(, 2 - Target.Column)) Then
If R(x, y).Interior.Color = vbRed Then a(1, x) = Lop(, y) & "*" _
Else a(1, x) = Lop(, y)
End If
Next
Next
Range("F" & Target.Row).Resize(, H - 1) = a
Else: Range("F" & Target.Row).Resize(, H - 1) = ""
End If
End If
End If
End Subcode này thì cập nhật được tiết *. nhưng nghinh ơi ý mình muốn khi mình gõ ngày tháng vào cột D thì cột C sẽ tự động cập nhật thứ luôn. ví dụ khi mình nhập 28/03/2014 vào cột D thì cột C tự động cập nhật là 6, khi nhập 23/03/2014 thì C tự đọng cập nhật là 8,....giống như thứ ngày của lịch van niên ấy. bạn thử xem lại file #1 mình mình đã đính kèm nhé. cảm ơn bạn
Bạn nghĩ là bạn muốn thêm "một chút" là dễ cho bạn, nhưng viết code thì ... phải bỏ hết, viết lại từ đầu.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Long, C As Long, Arr(1 To 1, 1 To 9)
Dim TenGV As String, Thu As Long, I As Long, J As Long
If Target.Column = 4 And Target.Count = 1 And Target.Row > 4 Then
If IsDate(Target) Then
TenGV = UCase(Target.Offset(, -2))
Thu = Weekday(Target)
Target.Offset(, -1) = Thu
R = Thu * 10 - 17
With Sheets("TKB")
C = .[IV3].End(xlToRight).Column
For I = 1 To 9
For J = 3 To C
If UCase(.Cells(R + I, J)) = TenGV Then
If .Cells(R + I, J).Interior.ColorIndex = 3 Then '-----------Mau do'
Arr(1, I) = .Cells(3, J).Value & "*"
Else
Arr(1, I) = .Cells(3, J).Value
End If
End If
Next J
Next I
End With
Target.Offset(, 2).Resize(, 9) = Arr
Else
Target.Offset(, -1) = Empty
Target.Offset(, 2).Resize(, 9) = Empty
End If
End If
End Subcảm ơn ba tê giúp đỡ vào đã góp ý với mình. code của bạn mình đã thử nhưng có lỗi hay sao ấy. khi mình gõ ngày 30/3/2014 (các ngày rơi vào chủ nhật ) thì code báo lỗi run-time.1004.bạn test lại thử xem nhé.
Má ơi! Chủ nhật cũng có người xin phép nghỉ.
cảm ơn ba tê nhé. cái msgbox hay quá ba tê ơi.file này do nhiều người cùng nhập liệu nên nếu để lỗi run-time .. nhiều người không hiểu thể nào cả. giờ thì tốt rồi. cảm ơn tất cả mọi người.
