cách chia nhóm theo 3 tiêu chí: điểm số, giới tính và số lượng thành viên

hoahongden142917 · 5/8/23

Kính chào các anh chị. Em có 1 file excel muốn thiết lập cho nó tự chia các em học sinh trong lớp thành nhiều nhóm nhỏ với 3 tiêu chí sau: mỗi nhóm có n em (nếu cò dư từ 1 đến 2 em thì cho nó vào bất kì nhóm nào cũng được), mỗi nhóm đều có nam và nữ, phân đều năng lực các em dựa theo điểm số về các nhóm
Phân bổ năng lực theo điểm số:
Từ 8 đến 10 điểm: A
Từ 7,5 đến dưới 8: B
Từ 6,5 đến dưới 7,5: C
Từ 5 đến dưới 6,5: D
Ví dụ: một lớp có tối đa 45 em (theo quy định): giả sử thầy đó chọn n = 5 (có 5 em/nhóm) thì chia ra có 9 nhóm trong đó mỗi nhóm có nam và nữ trộn vào (hoặc là 5 nam, 4 nữ hoặc là 4 nam, 5 nữ, hoặc nếu ít nữ thì chia 6 nam 3 nữ), mỗi nhóm có đủ A, B, C, D hoặc A, A, B, C, D hoặc A, B, B, C, D.
Rất mong được anh chị giúp đỡ, xin cảm ơn ạ.

HUONGHCKT · 5/8/23

hoahongden142917 đã viết:
Kính chào các anh chị. Em có 1 file excel muốn thiết lập cho nó tự chia các em học sinh trong lớp thành nhiều nhóm nhỏ với 3 tiêu chí sau: mỗi nhóm có n em (nếu cò dư từ 1 đến 2 em thì cho nó vào bất kì nhóm nào cũng được), mỗi nhóm đều có nam và nữ, phân đều năng lực các em dựa theo điểm số về các nhóm
Phân bổ năng lực theo điểm số:
Từ 8 đến 10 điểm: A
Từ 7,5 đến dưới 8: B
Từ 6,5 đến dưới 7,5: C
Từ 5 đến dưới 6,5: D
Ví dụ: một lớp có tối đa 45 em (theo quy định): giả sử thầy đó chọn n = 5 (có 5 em/nhóm) thì chia ra có 9 nhóm trong đó mỗi nhóm có nam và nữ trộn vào (hoặc là 5 nam, 4 nữ hoặc là 4 nam, 5 nữ, hoặc nếu ít nữ thì chia 6 nam 3 nữ), mỗi nhóm có đủ A, B, C, D hoặc A, A, B, C, D hoặc A, B, B, C, D.
Rất mong được anh chị giúp đỡ, xin cảm ơn ạ.

Sao không thấy giới tính nhỉ? Rõ ràng là phân chia theo : Giới tính(Nam, Nữ) và học lực cơ mà.

hoahongden142917 · 5/8/23

HUONGHCKT đã viết:
Sao không thấy giới tính nhỉ? Rõ ràng là phân chia theo : Giới tính(Nam, Nữ) và học lực cơ mà.

em gửi lại file rồi ạ.

HUONGHCKT · 5/8/23

hoahongden142917 đã viết:
em gửi lại file rồi ạ.

Trong khi chờ các giải pháp khác. Tạm thời thế này đã nhé.
Nhấn vào nút "Run Code" và thực hiện theo hướng dẫn.
Kết quả đang để ở Ô M2:....
Xem file
Code làm theo ý hiểu biết của bản thân (không có cơ bản) nên có dài, loằng ngoằng, nông dân,... tuy vẫn cho ra được kết quả. Mong các thành viên ghé qua xem và chỉ dẫn thêm. Trân trọng cảm ơn.

VetMini · 6/8/23

HUONGHCKT đã viết:
...
Code làm theo ý hiểu biết của bản thân (không có cơ bản) nên có dài, loằng ngoằng, nông dân,... tuy vẫn cho ra được kết quả. Mong các thành viên ghé qua xem và chỉ dẫn thêm. Trân trọng cảm ơn.

Loại bài như vầy thì cứ ra kết quả đúng là được rồi.
Nó không phải là một bài toán có giá trị lâu dài để phải bỏ công sức tìm giải thuật khoa học.
Khả năng người ta dùng 1 lần rồi sang khóa học tới nảy ra sáng kiến mới.

(đó la chưa kể cái file cũ rích, đáng lẽ phải được thiết kế lại)

HUONGHCKT · 6/8/23

VetMini đã viết:
Loại bài như vầy thì cứ ra kết quả đúng là được rồi.
Nó không phải là một bài toán có giá trị lâu dài để phải bỏ công sức tìm giải thuật khoa học.
Khả năng người ta dùng 1 lần rồi sang khóa học tới nảy ra sáng kiến mới.
(đó la chưa kể cái file cũ rích, đáng lẽ phải được thiết kế lại)

Cảm ơn anh đã xem bài và có lời chỉ dẫn.
Tôi làm theo file của thớt (sheet8a2) cũng không tính đến họ có dùng lâu dài hay không. Tất nhiên nếu dùng lâu dài và hữu dụng thực tế thì cũng cần phải thiết kế lại Sheet. Vả lại có thể cái sheet 8a1 mới là cái cần làm (theo điểm tổng kết học kỳ-năm học trước....) và cũng rất có thể sheet 8a1 ấy được thiết kế từ lâu rồi và là mẫu chung cho nhiều lớp, nhiều trường trong cùng 1 đơn vị, trên cùng 1 địa bàn.
Nói thật là tôi cũng không thấy động lực để cải tiến lại code cho gọn hơn tuy vẫn có ý tưởng làm bằng cách khác nữa.

hoahongden142917 · 6/8/23

HUONGHCKT đã viết:
Cảm ơn anh đã xem bài và có lời chỉ dẫn.
Tôi làm theo file của thớt (sheet8a2) cũng không tính đến họ có dùng lâu dài hay không. Tất nhiên nếu dùng lâu dài và hữu dụng thực tế thì cũng cần phải thiết kế lại Sheet. Vả lại có thể cái sheet 8a1 mới là cái cần làm (theo điểm tổng kết học kỳ-năm học trước....) và cũng rất có thể sheet 8a1 ấy được thiết kế từ lâu rồi và là mẫu chung cho nhiều lớp, nhiều trường trong cùng 1 đơn vị, trên cùng 1 địa bàn.
Nói thật là tôi cũng không thấy động lực để cải tiến lại code cho gọn hơn tuy vẫn có ý tưởng làm bằng cách khác nữa.

em cảm ơn anh. Thực ra file này em sẽ sử dụng lâu dài. Sheet 8a1 là xuất ra từ phần mềm theo dõi điểm vừa qua mà em quên xóa. File này em chỉ sử dụng sheet 8a2 thôi.
Theo hướng dạy học phát triển năng lực học sinh, đặc biệt em đang đi theo hướng cho học sinh đánh giá đồng đẳng sau khi tiết học kết thúc. Mà năm vừa rồi em thực hiện gặp 1 khâu khó khăn lớn nhất đó là chia nhóm. Khi dạy nhiều lớp việc chia nhóm theo năng lực cực kì khó khăn, nên năm nay em sẽ dùng file này để nó tự chia nhóm theo 4 tiêu chí ở trên, còn số nhóm thì tùy theo chủ đề dạy học hoặc tùy theo số lượng thiết bị dạy học ta chia thành HOẶC LÀ 4 EM/NHÓM, HOẶC 5 EM, HOẶC 6 EM,... NHƯNG ÍT NHẤT LÀ 4 EM/NHÓM. Vì thế em rất mong các anh giúp em với. Theo Chương trình giáo dục phổ thông 2018 thì việc tổ chức cho các em biết các giao tiếp, biết cách chắt lọc thông tin, biết cách thảo luận nhóm ... thì việc chia nhóm là cực kì quan trọng để nó loại bỏ ý nghĩ "mình học chậm vô nhóm có bạn học nhạy bén mình sẽ đỡ khổ, hoặc mình nhanh nhẹn mà vô chung nhóm với toàn bạn chậm thì khổ thân mình" Chính vì thế em mới đưa ra tiêu chí A, B, C, D ạ. xin cảm ơn

HUONGHCKT · 6/8/23

hoahongden142917 đã viết:
em cảm ơn anh. Thực ra file này em sẽ sử dụng lâu dài. Sheet 8a1 là xuất ra từ phần mềm theo dõi điểm vừa qua mà em quên xóa. File này em chỉ sử dụng sheet 8a2 thôi.
....
Anh ơi, sao file tải về em bấm nút chạy code mà nó không cho mặc dù em đã enable macro hết rồi ạ.

Bạn bấm nút Run Code nó có hiện ra 1 cái inputbox không? Khi hiện ra inputbox thì nhập số học sinh của 1 nhóm và nhấn OK===> sẽ có được kết quả.

hoahongden142917 · 6/8/23

Khi em chạy code:
1/ chọn 4 em/nhóm thì nó tách ra tới nhóm 5, nhóm 6 chỉ có 3 em/nhóm. trong lớp có 30 em thì 30/4 = 7 nhóm lẻ 2 em. Vậy lẻ 2 em đó em muốn nó chia đều vào nhóm bất kì với số lượng là chia 1 em vào 1 nhóm. (ví dụ đưa 1 em lẻ vào nhóm 1 và 1 em vào nhóm 2). xin cảm ơn anh.

HUONGHCKT · 7/8/23

hoahongden142917 đã viết:
Khi em chạy code:
1/ chọn 4 em/nhóm thì nó tách ra tới nhóm 5, nhóm 6 chỉ có 3 em/nhóm. trong lớp có 30 em thì 30/4 = 7 nhóm lẻ 2 em. Vậy lẻ 2 em đó em muốn nó chia đều vào nhóm bất kì với số lượng là chia 1 em vào 1 nhóm. (ví dụ đưa 1 em lẻ vào nhóm 1 và 1 em vào nhóm 2). xin cảm ơn anh.

Chỉnh lại:
Xem file. Còn vướng hoặc có vấn đề gì nữa thì liên hệ tôi qua zalo 0986997214 để tiện trao đổi.

hoahongden142917 · 9/8/23

HUONGHCKT đã viết:
Chỉnh lại:
Xem file. Còn vướng hoặc có vấn đề gì nữa thì liên hệ tôi qua zalo 0986997214 để tiện trao đổi.

Dạ. Em cảm ơn anh nhiều.

HUONGHCKT · 9/8/23

hoahongden142917 đã viết:
Dạ. Em cảm ơn anh nhiều.

Bạn đã sử dụng code được chưa?Có cần phải hỗ trợ gì thêm không.

hoahongden142917 · 10/8/23

HUONGHCKT đã viết:
Bạn đã sử dụng code được chưa?Có cần phải hỗ trợ gì thêm không.

Anh ơi, em kb zalo voi anh bang nick Phuong Hoang Lua.
Khi chạy số lượng 4 em/nhóm thì nó sắp nhóm 3,4,5 có 5 em, còn nhóm 7 có 3 em.
Nó tạo 7 nhóm là đúng số lượng, tuy nhiên còn dư 2 em nó phải để ngẫu nhiên vào bất kì nhóm nào cũng được (2 nhóm bất kì đó sẽ nhận 1 em có nghĩa là có 5 nhóm với số lượng 4 em/N; có 2 nhóm với số lượng 5 em/N)
Em cảm ơn anh.

HUONGHCKT · 10/8/23

hoahongden142917 đã viết:
Anh ơi, em kb zalo voi anh bang nick Phuong Hoang Lua.
Khi chạy số lượng 4 em/nhóm thì nó sắp nhóm 3,4,5 có 5 em, còn nhóm 7 có 3 em.
Nó tạo 7 nhóm là đúng số lượng, tuy nhiên còn dư 2 em nó phải để ngẫu nhiên vào bất kì nhóm nào cũng được (2 nhóm bất kì đó sẽ nhận 1 em có nghĩa là có 5 nhóm với số lượng 4 em/N; có 2 nhóm với số lượng 5 em/N)
Em cảm ơn anh.

Chỉnh lại code:

Mã:

Option Explicit

Sub ChiaNhom()
Dim i&, j&, t&, k&, Lr&, R&, n&, d&, A&, Z&, B&, Nu&
Dim dArr(), Arr(), KQ(), Res(), S(), Rng As Range
Dim SoNhom&, SoHS&
Dim Sh As Worksheet
Set Sh = Sheets("8a2")
'On Error GoTo Thoat
SoHS = InputBox("Hay nhâp sô hoc sinh cua 1 nhom vào Ô bên dươi", "CHIA HOC SINH THEO NHOM")
If Len(SoHS) = 0 Then
    MsgBox " Ban đa không chon sô hoc sinh cua 1 nhóm": Exit Sub
Else
Lr = Sh.Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To Lr
    If Sh.Cells(i, 5) >= 8 Then Sh.Cells(i, 6) = 1
    If Sh.Cells(i, 5) < 8 And Sh.Cells(i, 5) >= 7.5 Then Sh.Cells(i, 6) = 2
    If Sh.Cells(i, 5) < 7.5 And Sh.Cells(i, 5) >= 6.5 Then Sh.Cells(i, 6) = 3
    If Sh.Cells(i, 5) < 6.5 Then Sh.Cells(i, 6) = 4
    If Sh.Cells(i, 4) <> Empty Then Nu = Nu + 1
Next i
dArr = Sh.Range("A2:F" & Lr).Value
R = UBound(dArr)
ReDim Arr(1 To R, 1 To UBound(dArr, 2))
For j = 1 To 4
    For i = 1 To R
        If dArr(i, 6) = j Then
            If dArr(i, 4) <> Empty Then
                t = t + 1
                For Z = 1 To 6
                    Arr(t, Z) = dArr(i, Z)
                Next Z
            Else
                k = k + 1: B = k + Nu
                For Z = 1 To 6
                    Arr(B, Z) = dArr(i, Z)
                Next Z
            End If
        End If
    Next i
Next j

ReDim KQ(1 To R * (SoHS) * 2, 1 To 6)
SoNhom = Int((R / SoHS)) ' + 1
ReDim S(1 To 1, 1 To SoNhom)
k = 0
For i = 1 To UBound(Arr)
    If Arr(i, 4) <> Empty Then
        t = t + 1:    n = t Mod SoNhom
        If n = 0 Then A = A + 1: n = SoNhom
            k = (n - 1) * SoHS + 1: S(1, n) = k
            KQ(k + A, 2) = Arr(i, 2)
            KQ(k + A, 3) = Arr(i, 3)
            KQ(k + A, 4) = Arr(i, 4)
            KQ(k + A, 5) = Arr(i, 5)
            KQ(k + A, 6) = "Nhóm " & n
        End If
Next i

t = 0 ': d = 0
For i = UBound(Arr) To 1 Step -1
    If Arr(i, 4) = Empty Then
        t = t + 1:     n = t Mod SoNhom
        If n = 0 Then A = A + 1: n = SoNhom
            d = (n - 1) * SoHS + 1 + ((R * 2) + t)
            KQ(d, 2) = Arr(i, 2)
            KQ(d, 3) = Arr(i, 3)
            KQ(d, 4) = Arr(i, 4)
            KQ(d, 5) = Arr(i, 5)
            KQ(d, 6) = "Nhóm " & n
    End If
Next i
t = 0
ReDim Res(1 To UBound(KQ), 1 To 6)
For n = 1 To SoNhom
    For i = 1 To UBound(KQ)
        If KQ(i, 2) <> Empty And Right(KQ(i, 6), 1) = n Then
            t = t + 1:         Res(t, 1) = t
                For j = 2 To 6
                    Res(t, j) = KQ(i, j)
                Next j
        End If
    Next i
Next n

Sh.Range("M2").Resize(100, 7).ClearContents
Sh.Range("M2").Resize(R, 6) = Res
MsgBox " Thành công"
End If
Thoat:
End Sub

xem file đính kèm

HieuCD · 11/8/23

hoahongden142917 đã viết:
Kính chào các anh chị. Em có 1 file excel muốn thiết lập cho nó tự chia các em học sinh trong lớp thành nhiều nhóm nhỏ với 3 tiêu chí sau: mỗi nhóm có n em (nếu cò dư từ 1 đến 2 em thì cho nó vào bất kì nhóm nào cũng được), mỗi nhóm đều có nam và nữ, phân đều năng lực các em dựa theo điểm số về các nhóm
Phân bổ năng lực theo điểm số:
Từ 8 đến 10 điểm: A
Từ 7,5 đến dưới 8: B
Từ 6,5 đến dưới 7,5: C
Từ 5 đến dưới 6,5: D
Ví dụ: một lớp có tối đa 45 em (theo quy định): giả sử thầy đó chọn n = 5 (có 5 em/nhóm) thì chia ra có 9 nhóm trong đó mỗi nhóm có nam và nữ trộn vào (hoặc là 5 nam, 4 nữ hoặc là 4 nam, 5 nữ, hoặc nếu ít nữ thì chia 6 nam 3 nữ), mỗi nhóm có đủ A, B, C, D hoặc A, A, B, C, D hoặc A, B, B, C, D.
Rất mong được anh chị giúp đỡ, xin cảm ơn ạ.

Sort dữ liệu theo giới tính và năng lực xếp nhóm khá dể

Mã:

Sub XYZ()
  Dim Sh As Worksheet
  Dim arr(), aDiem, a, b, res()
  Dim soHS&, soNhom&, N&, i&, j&, k&, gt&
 
  Set Sh = Sheets("8a2")
  arr = Sh.Range("D2", Sh.Range("E" & Rows.Count).End(xlUp)).Value
  soHS = UBound(arr)
 
  On Error Resume Next
  N = InputBox("Hay nhap so hoc sinh cua 1 nhom vào o bên duoi", "CHIA HOC SINH THEO NHOM")
  If N = 0 Then
    MsgBox " Ban phai nhap sô hoc sinh cua 1 nhóm": Exit Sub
  End If
  If N > soHS Then N = soHS
 
  Randomize
  ReDim res(1 To soHS, 1 To 1)
  ReDim a(1 To 8) 'Chia HS thanh 8 nhom theo Gioi Tinh va Diem
  aDiem = Array(0, 8, 7.5, 6.5, 5)
  For i = 1 To soHS
    If Len(arr(i, 1)) = 2 Then gt = 0 Else gt = 1
    For j = 1 To 4
      If arr(i, 2) >= aDiem(j) Then
        a(j * 2 - gt) = a(j * 2 - gt) & "," & i
        Exit For
      End If
    Next j
  Next i
  a = Split(Join(a, ""), ",") 'xep thu tu HS theo GT va Diem
 
  soNhom = Int(soHS / N) 'Phan nhom HS thanh soNhom
  Do
    Call TaoMangNgauNhien(b, soNhom)
    For j = 1 To soNhom
      k = k + 1
      res(a(k), 1) = b(j)
      If k = soHS Then
        Sh.Range("F2").Resize(soHS) = res
        Exit Sub
      End If
    Next j
  Loop
End Sub

Sub TaoMangNgauNhien(aRnd, ByVal N)
  Dim i&, t&, r&
  ReDim aRnd(1 To N)
  For i = 1 To N
    r = Int(Rnd * N) + 1
    If aRnd(r) = 0 Then t = r Else t = aRnd(r)
    If aRnd(N) = 0 Then aRnd(r) = N Else aRnd(r) = aRnd(N)
    aRnd(N) = t
    N = N - 1
  Next i
End Sub

HUONGHCKT · 11/8/23

HieuCD đã viết:

Sort dữ liệu theo giới tính và năng lực xếp nhóm khá dể

Mã:

Sub XYZ()
  Dim Sh As Worksheet
  Dim arr(), aDiem, a, b, res()
  Dim soHS&, soNhom&, N&, i&, j&, k&, gt&
 
  Set Sh = Sheets("8a2")
  arr = Sh.Range("D2", Sh.Range("E" & Rows.Count).End(xlUp)).Value
  soHS = UBound(arr)
 
  On Error Resume Next
  N = InputBox("Hay nhap so hoc sinh cua 1 nhom vào o bên duoi", "CHIA HOC SINH THEO NHOM")
  If N = 0 Then
    MsgBox " Ban phai nhap sô hoc sinh cua 1 nhóm": Exit Sub
  End If
  If N > soHS Then N = soHS
 
  Randomize
  ReDim res(1 To soHS, 1 To 1)
  ReDim a(1 To 8) 'Chia HS thanh 8 nhom theo Gioi Tinh va Diem
  aDiem = Array(0, 8, 7.5, 6.5, 5)
  For i = 1 To soHS
    If Len(arr(i, 1)) = 2 Then gt = 0 Else gt = 1
    For j = 1 To 4
      If arr(i, 2) >= aDiem(j) Then
        a(j * 2 - gt) = a(j * 2 - gt) & "," & i
        Exit For
      End If
    Next j
  Next i
  a = Split(Join(a, ""), ",") 'xep thu tu HS theo GT va Diem
 
  soNhom = Int(soHS / N) 'Phan nhom HS thanh soNhom
  Do
    Call TaoMangNgauNhien(b, soNhom)
    For j = 1 To soNhom
      k = k + 1
      res(a(k), 1) = b(j)
      If k = soHS Then
        Sh.Range("F2").Resize(soHS) = res
        Exit Sub
      End If
    Next j
  Loop
End Sub

Sub TaoMangNgauNhien(aRnd, ByVal N)
  Dim i&, t&, r&
  ReDim aRnd(1 To N)
  For i = 1 To N
    r = Int(Rnd * N) + 1
    If aRnd(r) = 0 Then t = r Else t = aRnd(r)
    If aRnd(N) = 0 Then aRnd(r) = N Else aRnd(r) = aRnd(N)
    aRnd(N) = t
    N = N - 1
  Next i
End Sub

Cảm ơn Anh @HieuCD đã giúp tôi hoàn thành được bài này. Một bài mà tôi đã mất rất nhiều công sức để sửa lại theo yêu cầu qua tin nhắn riêng qua zalo
Lúc đầu tôi code cho phân chia số học sinh thành 4Hs/ nhóm, sửa đi sửa lại rồi cũng OK, nhưng khi phân chia thành 5Hs/nhóm, hoặc 6Hs/nhóm, hoặc ...thì có vấn đề. Tôi đã cũng viết lại code theo hướng sắp xếp ngẫu nghiên như kiểu làm số báo danh thì được, phân chia được theo học lực thì lại sai.
Đúng là code của chuyên gia có khác, nó đã giải quyết được 1 lần được tất cả các trường hợp mà lại ngắn gọn, chạy nhanh, tuy có hơi khó hiểu (đối với 1 kẻ gà mờ không có cơ bản như tôi)

HieuCD · 11/8/23

HUONGHCKT đã viết:
Cảm ơn Anh @HieuCD đã giúp tôi hoàn thành được bài này. Một bài mà tôi đã mất rất nhiều công sức để sửa lại theo yêu cầu qua tin nhắn riêng qua zalo
Lúc đầu tôi code cho phân chia số học sinh thành 4 nhóm, sửa đi sửa lại rồi cũng OK, nhưng khi phân chia thành 5, hoặc 6, hoặc thì có vấn đề. Tôi đã cũng viết lại code theo hướng sắp xếp ngẫu nghiên như kiểu làm số báo danh thì được, phân chia được theo học lực thì lại sai.
Đúng là code của chuyên gia có khác, nó đã giải quyết được 1 lần được tất cả các trường hợp mà lại ngắn gọn, chạy nhanh, tuy có hơi khó hiểu (đối với 1 kẻ gà mờ không có cơ bản như tôi)

Code bạn viết ngày càng khá, giải quyết được nhiều bài toán. Những vấn đề phức tạp cần nghỉ hướng giải thuật trước, thường là ghi ra nhiều hướng khác nhau và các bước thực hiện cơ bản sau đó mới viết code, viết xong vài ngày sau đem ra tìm cách viết lại từ từ bạn sẽ quen và code sẽ tốt hơn
Chúc bạn vui cả ngày /-*+/

HUONGHCKT · 11/8/23

HieuCD đã viết:
Code bạn viết ngày càng khá, giải quyết được nhiều bài toán. Những vấn đề phức tạp cần nghỉ hướng giải thuật trước, thường là ghi ra nhiều hướng khác nhau và các bước thực hiện cơ bản sau đó mới viết code, viết xong vài ngày sau đem ra tìm cách viết lại từ từ bạn sẽ quen và code sẽ tốt hơn
Chúc bạn vui cả ngày

Cảm ơn anh đã chỉ bảo.
Chúc anh và gia đình luôn vui, khỏe, hạnh phúc, bình an.

huuthang_bd · 11/8/23

HieuCD đã viết:

Sort dữ liệu theo giới tính và năng lực xếp nhóm khá dể

Mã:

Sub XYZ()
  Dim Sh As Worksheet
  Dim arr(), aDiem, a, b, res()
  Dim soHS&, soNhom&, N&, i&, j&, k&, gt&
 
  Set Sh = Sheets("8a2")
  arr = Sh.Range("D2", Sh.Range("E" & Rows.Count).End(xlUp)).Value
  soHS = UBound(arr)
 
  On Error Resume Next
  N = InputBox("Hay nhap so hoc sinh cua 1 nhom vào o bên duoi", "CHIA HOC SINH THEO NHOM")
  If N = 0 Then
    MsgBox " Ban phai nhap sô hoc sinh cua 1 nhóm": Exit Sub
  End If
  If N > soHS Then N = soHS
 
  Randomize
  ReDim res(1 To soHS, 1 To 1)
  ReDim a(1 To 8) 'Chia HS thanh 8 nhom theo Gioi Tinh va Diem
  aDiem = Array(0, 8, 7.5, 6.5, 5)
  For i = 1 To soHS
    If Len(arr(i, 1)) = 2 Then gt = 0 Else gt = 1
    For j = 1 To 4
      If arr(i, 2) >= aDiem(j) Then
        a(j * 2 - gt) = a(j * 2 - gt) & "," & i
        Exit For
      End If
    Next j
  Next i
  a = Split(Join(a, ""), ",") 'xep thu tu HS theo GT va Diem
 
  soNhom = Int(soHS / N) 'Phan nhom HS thanh soNhom
  Do
    Call TaoMangNgauNhien(b, soNhom)
    For j = 1 To soNhom
      k = k + 1
      res(a(k), 1) = b(j)
      If k = soHS Then
        Sh.Range("F2").Resize(soHS) = res
        Exit Sub
      End If
    Next j
  Loop
End Sub

Sub TaoMangNgauNhien(aRnd, ByVal N)
  Dim i&, t&, r&
  ReDim aRnd(1 To N)
  For i = 1 To N
    r = Int(Rnd * N) + 1
    If aRnd(r) = 0 Then t = r Else t = aRnd(r)
    If aRnd(N) = 0 Then aRnd(r) = N Else aRnd(r) = aRnd(N)
    aRnd(N) = t
    N = N - 1
  Next i
End Sub

Dạng bài này không hề đơn giản, nhất là khi dữ liệu không có tính cân xứng. Thớt cũng không mô tả quy luật ưu tiên trong từng trường hợp cụ thể nên tôi cũng không bàn thêm.
--
Xét trong trường hợp đơn giản nhất như sau:
Lớp có 32 học sinh, trong đó:

- 8 học sinh nữ điểm 9

- 8 học sinh nữ điểm 5

- 8 học sinh nam điểm 9

- 8 học sinh nam điểm 5

Cần chia thành 16 nhóm với mỗi nhóm có 2 học sinh

Dễ thấy với dữ liệu như trên cách chia phù hợp với yêu cầu của đầu bài là học sinh nữ điểm 5 chung nhóm với học sinh nam điểm 9 và học sinh nữ điểm 9 chung nhóm với học sinh nam điểm 5 nhưng code này chưa chia được như vậy.

hoahongden142917 · 11/8/23

HieuCD đã viết:

Sort dữ liệu theo giới tính và năng lực xếp nhóm khá dể

Mã:

Sub XYZ()
  Dim Sh As Worksheet
  Dim arr(), aDiem, a, b, res()
  Dim soHS&, soNhom&, N&, i&, j&, k&, gt&
 
  Set Sh = Sheets("8a2")
  arr = Sh.Range("D2", Sh.Range("E" & Rows.Count).End(xlUp)).Value
  soHS = UBound(arr)
 
  On Error Resume Next
  N = InputBox("Hay nhap so hoc sinh cua 1 nhom vào o bên duoi", "CHIA HOC SINH THEO NHOM")
  If N = 0 Then
    MsgBox " Ban phai nhap sô hoc sinh cua 1 nhóm": Exit Sub
  End If
  If N > soHS Then N = soHS
 
  Randomize
  ReDim res(1 To soHS, 1 To 1)
  ReDim a(1 To 8) 'Chia HS thanh 8 nhom theo Gioi Tinh va Diem
  aDiem = Array(0, 8, 7.5, 6.5, 5)
  For i = 1 To soHS
    If Len(arr(i, 1)) = 2 Then gt = 0 Else gt = 1
    For j = 1 To 4
      If arr(i, 2) >= aDiem(j) Then
        a(j * 2 - gt) = a(j * 2 - gt) & "," & i
        Exit For
      End If
    Next j
  Next i
  a = Split(Join(a, ""), ",") 'xep thu tu HS theo GT va Diem
 
  soNhom = Int(soHS / N) 'Phan nhom HS thanh soNhom
  Do
    Call TaoMangNgauNhien(b, soNhom)
    For j = 1 To soNhom
      k = k + 1
      res(a(k), 1) = b(j)
      If k = soHS Then
        Sh.Range("F2").Resize(soHS) = res
        Exit Sub
      End If
    Next j
  Loop
End Sub

Sub TaoMangNgauNhien(aRnd, ByVal N)
  Dim i&, t&, r&
  ReDim aRnd(1 To N)
  For i = 1 To N
    r = Int(Rnd * N) + 1
    If aRnd(r) = 0 Then t = r Else t = aRnd(r)
    If aRnd(N) = 0 Then aRnd(r) = N Else aRnd(r) = aRnd(N)
    aRnd(N) = t
    N = N - 1
  Next i
End Sub

em cảm ơn anh nhiều lắm. em đang cho nó chạy thử anh ạ.

cách chia nhóm theo 3 tiêu chí: điểm số, giới tính và số lượng thành viên

Thành viên hoạt động

File đính kèm

Zalo 0986997214

Thành viên hoạt động

Zalo 0986997214

File đính kèm

Ăn cùng góc phố

Zalo 0986997214

Thành viên hoạt động

Zalo 0986997214

File đính kèm

Thành viên hoạt động

File đính kèm

Zalo 0986997214

File đính kèm

Thành viên hoạt động

Zalo 0986997214

Thành viên hoạt động

File đính kèm

Zalo 0986997214

File đính kèm

Chuyên gia GPE

Zalo 0986997214

Chuyên gia GPE

Zalo 0986997214

Chuyên gia GPE

Thành viên hoạt động