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

Liên hệ QC
Code chỉ xét giám thị coi thi, bạn phải khai báo chính xác 2 dòng lệnh
Const rAddress As String = "J4:N182" 'Dia chi Nhap lieu ("J4:N182" sai)
Const SoPhong As Long = 16 'So phong thi
Nếu xét giám sát phải có code bổ xung thêm vì yêu cầu ? sẽ rất khác giám thị
 
Code chỉ xét giám thị coi thi, bạn phải khai báo chính xác 2 dòng lệnh
Const rAddress As String = "J4:N182" 'Dia chi Nhap lieu ("J4:N182" sai)
Const SoPhong As Long = 16 'So phong thi
Nếu xét giám sát phải có code bổ xung thêm vì yêu cầu ? sẽ rất khác giám thị
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.
 
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?
 
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!
 
Lần chỉnh sửa cuối:
Ở đâ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ì?
 
Dạ không anh VD: có 10 giám sát thì phiếu từ GS1 đến GS10 Anh
Chỉnh code
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 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 Sub
 
Chỉnh code
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 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 Sub
Dạ 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.
 
Lần chỉnh sửa cuối:
1597243164704.png
Nhờ anh HieuCD giúp em chổ này anh nha! trong file Excel em muốn khi chèn thêm một số dòng với điều kiện các hàm vẫn chạy liên tục.
 

File đính kèm

  • 8. Phân công CBCT THPT 2020.xlsm
    104 KB · Đọc: 4
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.
ví dụ: bên sheet Bốc thăm PCGT người bốc thăm được 1.1 là Nguyễn Kiều Tiên thì tự đọng điền vào sheet Van "Cán Bộ Coi Thi 1" là Nguyễn Kiều Tiên như trong file em gởi.
 
Lần chỉnh sửa cuối:
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.
ví dụ: bên sheet Bốc thăm PCGT người bốc thăm được 1.1 là Nguyễn Kiều Tiên thì tự đọng điền vào sheet Van "Cán Bộ Coi Thi 1" là Nguyễn Kiều Tiên như trong file em gởi.
Nên dùng công thức lồng hàm Iferror
Mỗi lần tổ chức thi, tạo file với số dòng phù hợp số phòng
 

File đính kèm

  • 8. Phân công CBCT THPT 2020.xlsm
    102.2 KB · Đọc: 7
Web KT
Back
Top Bottom