Nhờ anh em diễn đàn giúp mình code này!

Liên hệ QC

phamxuanyen

Thành viên mới
Tham gia
1/9/08
Bài viết
42
Được thích
7
Mình muốn phân công giám thị coi thi THPT năm 2020 với điều kiện như sau:
1. giám thị coi thi một phòng không quá 1 lần (Bốc thăm)
2. Cặp giám thị coi thi không trùng nhau >1 lân
Rất mong mấy pro giúp đỡ. Cám ơn rất nhiều
 

File đính kèm

  • Phân công CBCT THPT 2020 test.xlsx
    85.6 KB · Đọc: 36
Chỉ cần code khi nhập vào trùng thì nó báo
không trùng thì thôi
 
có thể hướng dẫn mình duoc khong
 
Xin lỗi vì ngoài ngành nên chưa rõ thế nào là trùng trong phòng & trùng nhau trong 1 cặp cả(?)
& Bạn nên gởi bài đăng vô ngăn 'Lập trình. . . ', nên vậy.
 
Xin lỗi vì ngoài ngành nên chưa rõ thế nào là trùng trong phòng & trùng nhau trong 1 cặp cả(?)
& Bạn nên gởi bài đăng vô ngăn 'Lập trình. . . ', nên vậy.
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. :)
 
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ới
 
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ò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
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
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
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
 
Chỉ cần báo trùng cà cho giám thị dó bốc lại
Xem code trong sheet PCCT
Mã:
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 Sub
 

File đính kèm

  • Phân công CBCT THPT 2020 test.xlsm
    97.1 KB · Đọc: 14
Xem code trong sheet PCCT
Mã:
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 Sub
Nế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
 
Dùng bàn phím nhập 1 ô duy nhất, không copy dán nhiều ô
Chỉnh vùng nhập liệu mới (nếu khác) trong dòng lệnh
Const rAddress As String = "J4:N35" 'Dia chi Nhap lieu
Dạ em Cảm ơn rất nhiều. phân công coi thi kho thiet anh ơi
Bài đã được tự động gộp:

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
Const rAddress As String = "J4:N50" 'Dia chi Nhap lieu
mà không duoc anh. em muốn nhập thêm GS1, GS2, GS3......... em phải làm sao vậy anh! rất mong anh giúp em
 

File đính kèm

  • Capture.PNG
    Capture.PNG
    97.9 KB · Đọc: 11
Lần chỉnh sửa cuối:
Dạ em Cảm ơn rất nhiều. phân công coi thi kho thiet anh ơi
Bài đã được tự động gộp:


em muốn nhập chữ giám sát 1,2,3... từ dòng j36 đến n50
Const rAddress As String = "J4:N50" 'Dia chi Nhap lieu
mà không duoc anh. em muốn nhập thêm GS1, GS2, GS3......... em phải làm sao vậy anh! rất mong anh giúp em
 

File đính kèm

  • Phân công CBCT THPT 2020 test.xlsm
    43 KB · Đọc: 9
Web KT
Back
Top Bottom