Nhờ anh HieuCD và các anh em diễn đàn code giúp em! (3 người xem)

[phamxuanyen]

Nhập dữ liệu vào Sheet1 và Sheet2
Code phân công theo tỷ lệ số Giám thị của từng đơn vị và chọn Giám thị ngẫu nhiên, mỗi lần chạy Sub Main sẽ có kết quả khác nhau

  Dim eRow&, sRow&, i&, iR&, j&, jC&
  Dim soGV&, soNhom&, soDV&, DV$, tmp

Sub Main()
  Dim aNhom(), aGV(), aPhanBo(), Res()

  Sheets("KetQua").UsedRange.Offset(3).ClearContents
  With Sheets("Sheet2")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong chia nhom"): Exit Sub
    aNhom = .Range("B5:C" & eRow).Value 'Mang Nhom
    soGV = .Range("C4").Value 'So Giao Vien
    soNhom = UBound(aNhom) 'So Nhom
  End With
  With Sheets("Sheet1")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 4 Then MsgBox ("Khong co Giao Vien"): Exit Sub
    .Range("A4:E4").Resize(soGV).Copy Sheets("KetQua").Range("A4")
  End With
  With Sheets("KetQua")
    .Range("A3:F" & eRow).Sort .Range("E3"), 1, Header:=xlYes
    aGV = .Range("E4:E" & eRow).Value 'Mang Giao Vien
    If UBound(aGV) <> soGV Then MsgBox ("So Luong GV Chia Nhom Khong Dung"): Exit Sub
  
    Call TaoMang_aPhanBo(aNhom, aGV, aPhanBo) 'Tao Bang Phan Bo Giao Vien theo ty le
    ReDim Res(1 To soGV, 1 To 1)
    Call PhanBoGiaoVien(aNhom, aPhanBo, Res) 'Phan bo Giao Vien
    .Range("F4").Resize(soGV) = Res 'Xep thu tu theo Don Vi
  
    .Range("B4:F4").Resize(soGV).Copy .Range("I4") 'Xep thu tu theo Nhom
    .Range("H3:M" & eRow).Sort .Range("M3"), 1, Header:=xlYes
    .Range("A4").Resize(soGV).Copy .Range("H4")
  End With
End Sub

Private Sub PhanBoGiaoVien(aNhom, aPhanBo, Res)
  Dim Arr() As Long, k As Long
  For j = 1 To soDV 'Phan bo Giao Vien tung Don Vi
    ReDim Arr(1 To aPhanBo(0, j))
    Call TaoMangNgauNhien(Arr, aPhanBo(0, j))
    jC = 0
    For i = 1 To soNhom
      For iR = 1 To aPhanBo(i, j)
        jC = jC + 1
        Res(k + Arr(jC), 1) = aNhom(i, 1)
      Next iR
    Next i
    k = k + jC
  Next j
End Sub

Private Sub TaoMangNgauNhien(Arr, ByVal N&)
  Randomize
  For i = 1 To N
    iR = Int(N * Rnd() + 1)
    If Arr(iR) = 0 Then tmp = iR Else tmp = Arr(iR)
    If Arr(N) = 0 Then Arr(iR) = N Else Arr(iR) = Arr(N)
    Arr(N) = tmp
    N = N - 1
  Next i
End Sub

Private Sub TaoMang_aPhanBo(aNhom, aGV, aPhanBo)
  soDV = 0
  For i = 1 To soGV 'Tao Mang Phan Bo
    If DV <> aGV(i, 1) Then
      DV = aGV(i, 1)
      soDV = soDV + 1 'So Don vi
      ReDim Preserve aPhanBo(-2 To soNhom, 0 To soDV)
      aPhanBo(-2, soDV) = DV: aPhanBo(-1, soDV) = 1
    Else
      aPhanBo(-1, soDV) = aPhanBo(-1, soDV) + 1
    End If
  Next i
  For j = 1 To soDV 'Phan bo Giao Vien theo Ty Le
    tmp = aPhanBo(-1, j) / soGV 'Ty le Phan Bo
    For i = 1 To soNhom
      aPhanBo(i, j) = Round(aNhom(i, 2) * tmp, 0)
      aPhanBo(0, j) = aPhanBo(0, j) + aPhanBo(i, j)
      aPhanBo(i, 0) = aPhanBo(i, 0) + aPhanBo(i, j)
    Next i
  Next j

  For j = 1 To soDV 'Dieu chinh tong so theo Don Vi (Cot)
    If tmp < aPhanBo(0, j) Then tmp = aPhanBo(0, j): jC = j 'Don Vi co so Giam Thi Nhieu nhat
    If aPhanBo(0, j) > aPhanBo(-1, j) Then
      i = 0
      Do While aPhanBo(0, j) > aPhanBo(-1, j)
        If i = soNhom Then i = 1 Else i = i + 1
        If aPhanBo(i, 0) > aNhom(i, 2) Then
          aPhanBo(i, j) = aPhanBo(i, j) - 1
          aPhanBo(0, j) = aPhanBo(0, j) - 1
          aPhanBo(i, 0) = aPhanBo(i, 0) - 1
        End If
      Loop
    ElseIf aPhanBo(0, j) < aPhanBo(-1, j) Then
      i = 0
      Do While aPhanBo(0, j) < aPhanBo(-1, j)
        If i = soNhom Then i = 1 Else i = i + 1
        If aPhanBo(i, 0) < aNhom(i, 2) Then
          aPhanBo(i, j) = aPhanBo(i, j) + 1
          aPhanBo(0, j) = aPhanBo(0, j) + 1
          aPhanBo(i, 0) = aPhanBo(i, 0) + 1
        End If
      Loop
    End If
  Next j

  For i = 1 To soNhom 'Dieu chinh tong so theo Nhom (Dong)
    If aPhanBo(i, 0) > aNhom(i, 2) Then
      Do While aPhanBo(i, 0) > aNhom(i, 2)
        If iR = soNhom Then iR = 1 Else iR = iR + 1
        If aPhanBo(iR, 0) < aNhom(iR, 2) Then
          aPhanBo(i, jC) = aPhanBo(i, jC) - 1
          aPhanBo(i, 0) = aPhanBo(i, 0) - 1
          aPhanBo(iR, jC) = aPhanBo(iR, jC) + 1
          aPhanBo(iR, 0) = aPhanBo(iR, 0) + 1
        End If
      Loop
    ElseIf aPhanBo(i, 0) > aNhom(i, 2) Then
      Do While aPhanBo(i, 0) < aNhom(i, 2)
        If iR = soNhom Then iR = 1 Else iR = iR + 1
        If aPhanBo(iR, 0) < aNhom(iR, 2) Then
          aPhanBo(i, jC) = aPhanBo(i, jC) + 1
          aPhanBo(i, 0) = aPhanBo(i, 0) + 1
          aPhanBo(iR, jC) = aPhanBo(iR, jC) - 1
          aPhanBo(iR, 0) = aPhanBo(iR, 0) - 1
        End If
      Loop
    End If
  Next i
End Sub

Sub XoaKetQua()
  Sheets("KetQua").UsedRange.Offset(3).ClearContents
End Sub

Rất ok anh! em cảm ơn anh rất nhiều!

 

[phamxuanyen]

Rất ok anh! em cảm ơn anh rất nhiều!

anh có thể giúp em code từ danh sách chung khi chay chương trình có ra các sheet như file đính kèm được không anh. Điều kiện trong sheet thống kê là những điểm thi đánh dấu x thì giáo viên ở trường đó không được coi thi tại điểm thi đó. ví dụ: Số lượng cán bộ coi thi phải theo ma trận ở Bảng thống kê (lưu ý cán bộ, giáo viên ko được làm thi tại nơi có học sinh thi); có chức năng để add thêm Trưởng điểm, Phó Trưởng điểm, thư ký, giám sát, cán bộ coi thi dự phòng, công an, y tế, bảo vệ, phục vụ; thêm phần hỗ trợ thay đổi cán bộ làm thi khi có sự cố xin vắng hoặc hoán đổi địa điểm làm thi. rất mong các anh trên diễn đàn giúp em.

 

[HieuCD]

anh có thể giúp em code từ danh sách chung khi chay chương trình có ra các sheet như file đính kèm được không anh. Điều kiện trong sheet thống kê là những điểm thi đánh dấu x thì giáo viên ở trường đó không được coi thi tại điểm thi đó. ví dụ: Số lượng cán bộ coi thi phải theo ma trận ở Bảng thống kê (lưu ý cán bộ, giáo viên ko được làm thi tại nơi có học sinh thi); có chức năng để add thêm Trưởng điểm, Phó Trưởng điểm, thư ký, giám sát, cán bộ coi thi dự phòng, công an, y tế, bảo vệ, phục vụ; thêm phần hỗ trợ thay đổi cán bộ làm thi khi có sự cố xin vắng hoặc hoán đổi địa điểm làm thi. rất mong các anh trên diễn đàn giúp em.

1/ Bảng thống kê không khớp số lượng giáo viên các trường
2/ Yêu cầu của bạn khá cao, cần nhiều thời gian mới hoàn thành dự án. Bạn trình dự án cho giám đốc sở, đặt hàng viết phần mềm từ công ty tin học hoặc bộ phận IT của sở

 

[tigertiger]

anh có thể giúp em code từ danh sách chung khi chay chương trình có ra các sheet như file đính kèm được không anh. Điều kiện trong sheet thống kê là những điểm thi đánh dấu x thì giáo viên ở trường đó không được coi thi tại điểm thi đó. ví dụ: Số lượng cán bộ coi thi phải theo ma trận ở Bảng thống kê (lưu ý cán bộ, giáo viên ko được làm thi tại nơi có học sinh thi); có chức năng để add thêm Trưởng điểm, Phó Trưởng điểm, thư ký, giám sát, cán bộ coi thi dự phòng, công an, y tế, bảo vệ, phục vụ; thêm phần hỗ trợ thay đổi cán bộ làm thi khi có sự cố xin vắng hoặc hoán đổi địa điểm làm thi. rất mong các anh trên diễn đàn giúp em.

Bên giáo dục có phần mềm hết rồi, bạn (chủ topic) nên liên hệ với các sở ban ngành , bộ phận IT tin học hóa của các cơ quan đó, để được trợ giúp - Excel không giúp được những điều đòi hỏi đó đâu.
Và cá nhân làm mất công

 

[phamxuanyen]

1/ Bảng thống kê không khớp số lượng giáo viên các trường
2/ Yêu cầu của bạn khá cao, cần nhiều thời gian mới hoàn thành dự án. Bạn trình dự án cho giám đốc sở, đặt hàng viết phần mềm từ công ty tin học hoặc bộ phận IT của sở

cảm ơn anh rất nhiều.

Bài đã được tự động gộp: 28/11/20

1/ Bảng thống kê không khớp số lượng giáo viên các trường
2/ Yêu cầu của bạn khá cao, cần nhiều thời gian mới hoàn thành dự án. Bạn trình dự án cho giám đốc sở, đặt hàng viết phần mềm từ công ty tin học hoặc bộ phận IT của sở

nếu có thời gian rảnh anh nghiên cứu giúp em cái nha anh!