Khỏi code, dùng định dạng có điều kiện, trùng thì nó có màu khác dễ phân biệt.
xin duoc giúp code voi các pro oi
Chắc là: Có 2 ông giám thị A và B bốc thăm lần thứ nhất coi phòng thi số 1 thì bốc thăm lần thứ hai hai ông này không được coi phòng số 1 nữa và hai ông này cũng không được cặp với nhau coi thi phòng khác nữa.
Dạ đúng như vậy! nhưng không biết làm sao? nhờ anh (chị) giúp em vớiChắc là: Có 2 ông giám thị A và B bốc thăm lần thứ nhất coi phòng thi số 1 thì bốc thăm lần thứ hai hai ông này không được coi phòng số 1 nữa và hai ông này cũng không được cặp với nhau coi thi phòng khác nữa.
Buổi thi cuối, những người bốc thăm cuối có khả năng trùng 100%, qui trình xử lý trường hợp nầy như thế nào?
Phòng thi từ 10 phòng trở lên, số lượng giám thị từ 20 người trở lên. thi trong 4 buổi nên số lượng trùng lại rất ít. nhưng có cách nào khì nhập nười bốc thăm vào. nếu trùng thì nó báo.
Phải biết qui trình thao tác xử lý khi bị trùng mới viết code hoàn chỉnh được
Chỉ cần báo trùng cà cho giám thị dó bốc lại
Anh có thể giúp em được không? VD: có 20 người chia làm 2 nhóm bốc thăm coi thi (có 4 buổi thi) điều kiện là giám thị nhóm 1 và 2 không coi thi trùng phòng lại và cặp giám thị đó không coi trùng với nhau ở lần coi thi tiếp theo
Xem code trong sheet PCCT
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, S, bTest As Boolean
Dim Phong_Loai, phong&, NV$, tmp
Dim fRow&, eRow&, fCol&, eCol&, iR&, jC&, i&, j&, ik&
Const rAddress As String = "J4:N35" 'Dia chi Nhap lieu
Const SoPhong As Long = 16 'So phong thi
Set Rng = Range(rAddress)
If Intersect(Target, Rng) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub 'Chi xet nhap 1 cell
Phong_Loai = Target.Value
If Phong_Loai = Empty Then Exit Sub
bTest = False
If InStr(1, Phong_Loai, ".") > 0 Then
S = Split(Phong_Loai, ".")
If IsNumeric(S(0)) And (S(1) = "1" Or S(1) = "2") Then
phong = CLng(S(0)) 'STT Phong thi
Phong_Loai = phong & "." & S(1)
If phong >= 1 And phong <= SoPhong Then bTest = True
End If
End If
Call TangToc(False)
Target.Select
If bTest = False Then
MsgBox ("Nhap sai Ma Phong_Nhom Giam thi")
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
fRow = Rng.Row: eRow = fRow + Rng.Rows.Count - 1
fCol = Rng.Column: eCol = fCol + Rng.Columns.Count - 1
iR = Target.Row: jC = Target.Column
For j = fCol To eCol
If j <> jC Then
tmp = cells(iR, j).Value 'Phong_Loai
If InStr(1, tmp, ".") > 0 Then
If phong = CLng(Split(tmp, ".")(0)) Then
MsgBox ("Trung phong Mon: " & cells(3, j))
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
End If
End If
Next j
NV = Range("A" & iR).Value
k = 0
For i = fRow To eRow
If i <> iR Then
If InStr(1, cells(i, jC), phong & ".") = 1 Then
If Phong_Loai = cells(i, jC) Then
MsgBox (Phong_Loai & " Nhap trung 2 lan")
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
k = k + 1
If k > 1 Then
MsgBox ("Ma Phong: " & phong & "co hon 2 giam thi")
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
ik = i
End If
End If
Next i
If k = 1 Then
For j = fCol To eCol
tmp = cells(ik, j) 'Phong_Loai
If InStr(1, tmp, ".") Then
If j <> jC Then
tmp = CLng(Split(tmp, ".")(0)) 'Phong
For i = fRow To eRow
If InStr(1, cells(i, j), ".") Then
If tmp = CLng(Split(cells(i, j), ".")(0)) Then
If NV = cells(i, 1) Then
MsgBox ("Trung Giam Thi: " & cells(ik, 8).Value)
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
End If
End If
Next i
End If
End If
Next j
End If
If Target.Value <> Phong_Loai Then Target.Value = Phong_Loai
If iR < eRow Then cells(iR + 1, jC).Select Else cells(fRow, jC + 1).Select
Call TangToc(True)
End Sub
Private Sub TangToc(ByVal bTest As Boolean)
Application.ScreenUpdating = bTest
Application.EnableEvents = bTest
End SubNếu em làm số phòng nhiều hơn 16 và nhỏ hơn 16 thì em phải làm sao anh
Trong code mình đã ghi chú các tham số cần chú ý như
Dạ Cảm ơn anh rất nhiều!
Dùng bàn phím nhập 1 ô duy nhất, không copy dán nhiều ô
Dạ em Cảm ơn rất nhiều. phân công coi thi kho thiet anh ơi
em muốn nhập chữ giám sát 1,2,3... từ dòng j36 đến n50
Vậy Anh có thể giúp em code bổ xung đó không anh! Giám sát một người giám sát cao nhất 5 phòng; không trùng phòng lại thôi anh.
Phải nói rỏ yêu cầu, giám sát thường phân theo khu vực, có bao nhiêu khu vực? mỗi khu vực có bao nhiêu giám sát? số lượng môn thi là bao nhiêu?
Ở đây không có khu vực anh, mà chỉ có số lượng phòng thi anh. ví dụ: có 22 phòng thi thì số lượng giám thi là 44 người; còn giám sát 7 hoặc 8 người (Giám sát là do mình qui định giám sát số phòng thi như giams sát 1 giám sát phòng 1,2,3; giám sát 2 có thể qui định giám sát phòng 1,2,3,4,5; giám sát 3 có thể qui định giám sát phòng 1,2; nhưng giám sát không quá 5 phòng thi và không trùng lại số phòng đã giám sát ) như vậy đó anh. còn số buổi giám sát giống như giám thị là 04 buổi anh. Anh ranh code giúp em cái nha anh!
Phiếu bốc thăm của giám sát ghi gì?
GS1; GS2; GS3; .......... ANH
Các phiếu có khi nào trùng nhau? ví dụ có 2 giám sát GS1 không?
Dạ không anh VD: có 10 giám sát thì phiếu từ GS1 đến GS10 Anh
Chỉnh code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, S, bTest As Boolean
Dim Phong_Loai, phong&, NV$, tmp
Dim fRow&, eRow&, fCol&, eCol&, iR&, jC&, i&, j&, ik&
Const rGiamThi As String = "J4:N35" 'Dia chi Nhap lieu Giam Thi
Const SoPhong As Long = 16 'So phong thi
Const rGiamSat As String = "J36:N40" 'Dia chi Nhap lieu Giam Sat
Const SoPhieuGS As Long = 5 'So phieu boc tham GS
If Target.Count > 1 Then Exit Sub 'Chi xet nhap 1 cell
If Not Intersect(Target, Range(rGiamThi)) Is Nothing Then
Set Rng = Range(rGiamThi)
Phong_Loai = Target.Value
If Phong_Loai = Empty Then Exit Sub
bTest = False
If InStr(1, Phong_Loai, ".") > 0 Then
S = Split(Phong_Loai, ".")
If IsNumeric(S(0)) And (S(1) = "1" Or S(1) = "2") Then
phong = CLng(S(0)) 'STT Phong thi
Phong_Loai = phong & "." & S(1)
If phong >= 1 And phong <= SoPhong Then bTest = True
End If
End If
Call TangToc(False)
Target.Select
If bTest = False Then
MsgBox ("Nhap sai Ma Phong_Nhom Giam thi")
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
fRow = Rng.Row: eRow = fRow + Rng.Rows.Count - 1
fCol = Rng.Column: eCol = fCol + Rng.Columns.Count - 1
iR = Target.Row: jC = Target.Column
For j = fCol To eCol
If j <> jC Then
tmp = cells(iR, j).Value 'Phong_Loai
If InStr(1, tmp, ".") > 0 Then
If phong = CLng(Split(tmp, ".")(0)) Then
MsgBox ("Trung phong Mon: " & cells(3, j))
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
End If
End If
Next j
NV = Range("A" & iR).Value
k = 0
For i = fRow To eRow
If i <> iR Then
If InStr(1, cells(i, jC), phong & ".") = 1 Then
If Phong_Loai = cells(i, jC) Then
MsgBox (Phong_Loai & " Nhap trung 2 lan")
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
k = k + 1
If k > 1 Then
MsgBox ("Ma Phong: " & phong & "co hon 2 giam thi")
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
ik = i
End If
End If
Next i
If k = 1 Then
For j = fCol To eCol
tmp = cells(ik, j) 'Phong_Loai
If InStr(1, tmp, ".") Then
If j <> jC Then
tmp = CLng(Split(tmp, ".")(0)) 'Phong
For i = fRow To eRow
If InStr(1, cells(i, j), ".") Then
If tmp = CLng(Split(cells(i, j), ".")(0)) Then
If NV = cells(i, 1) Then
MsgBox ("Trung Giam Thi: " & cells(ik, 8).Value)
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
End If
End If
Next i
End If
End If
Next j
End If
If Target.Value <> Phong_Loai Then Target.Value = Phong_Loai
If iR < eRow Then cells(iR + 1, jC).Select Else cells(fRow, jC + 1).Select
ElseIf Not Intersect(Target, Range(rGiamSat)) Is Nothing Then
Set Rng = Range(rGiamSat)
Phong_Loai = UCase(Target.Value)
If Phong_Loai = Empty Then Exit Sub
bTest = False
If InStr(1, Phong_Loai, "GS") > 0 Then
If Len(Phong_Loai) > 2 Then
tmp = Replace(Phong_Loai, "GS", "") 'STT Khu Vuc Giam Sat
If IsNumeric(tmp) Then
phong = CLng(tmp) 'STT Khu Vuc Giam Sat
If phong <= SoPhieuGS Then
Phong_Loai = "GS" & phong 'Khu Vuc Giam Sat
bTest = True
End If
End If
End If
End If
Call TangToc(False)
Target.Select
If bTest = False Then
MsgBox ("Nhap sai Phieu Giam Sat")
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
fRow = Rng.Row: eRow = fRow + Rng.Rows.Count - 1
fCol = Rng.Column: eCol = fCol + Rng.Columns.Count - 1
iR = Target.Row: jC = Target.Column
For j = fCol To eCol
If j <> jC Then
If Phong_Loai = cells(iR, j).Value Then
MsgBox ("Trung phong Mon: " & cells(3, j))
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
End If
Next j
For i = fRow To eRow
If i <> iR Then
If Phong_Loai = cells(i, jC) Then
MsgBox (Phong_Loai & ": Nhap trung GS " & cells(i, 8))
Target.Value = Empty '***
Call TangToc(True)
Exit Sub
End If
End If
Next i
If Target.Value <> Phong_Loai Then Target.Value = Phong_Loai
If iR < eRow Then cells(iR + 1, jC).Select Else cells(fRow, jC + 1).Select
End If
Call TangToc(True)
End Sub
Private Sub TangToc(ByVal bTest As Boolean)
Application.ScreenUpdating = bTest
Application.EnableEvents = bTest
End SubDạ cảm ơn anh rất nhiều! anh có thể cho em địa chỉ hay số điện thoại được không? khi nao em đến em hậu tạ anh nha! thành ý anh nha! không có chuyện gì khác.
Nếu code này không cần ràng buộc không trùng cặp giám thị thì mình bỏ lệnh nào anh
Bỏ 2 dòng lệnh bằng cách thêm dấu nháy đơn trước lệnh
Dạ Cảm ơn anh để em sưa lại
Không hiểu, nói rỏ hơn
khi em chèn thêm bất kì dòng nào thì hàm vẫn chạy theo. chứ như hình thì khi em chèn thêm phải kéo xuống mới có hàm đó anh. Hoặc có cách nòa khi bốc thăm môn văn ở sheet "Bốc thăm PCGT" ở cột ngữ văn thì ở bên "sheet Van" tự động điền tên người đó vào sheet văn không anh.
Nên dùng công thức lồng hàm Iferror
Dạ em cảm ơn anh!
Dùng công cụ Table của Excel, chọn vùng dữ liệu, chọn menu Insert, chọn Table để chuyển đổi Range thành Table
Cảm ơn anh rất nhiều
