Có bao nhiêu cách chia 6 người thành 3 nhóm

Question

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

Nội dung chính Show