Sắp xếp ngẫu nhiên có điều kiện

[BuiQuangThuan]

Chào các thầy cô và các anh chị ạ
Em đang có vướng mắc xíu trong công việc nhờ mọi người giúp với ạ.

Hiện tại em đang có 4 người như hình:

Và các công đoạn. Phần công đoạn có thể nhiều hơn hoặc ít hơn.
Giờ muốn lấy ngẫu nhiên 3 người cho từng công đoạn với điều kiện là tổng số lần xuất hiện của từng người cho các công đoạn ngang ngang nhau. Tránh người làm nhiều quá, người làm ít quá.
Mong thầy cô và các anh chị giúp đỡ ạ.

 

[CHAOQUAY]

Chào các thầy cô và các anh chị ạ
Em đang có vướng mắc xíu trong công việc nhờ mọi người giúp với ạ.

Hiện tại em đang có 4 người như hình:
View attachment 240830
Và các công đoạn. Phần công đoạn có thể nhiều hơn hoặc ít hơn.
Giờ muốn lấy ngẫu nhiên 3 người cho từng công đoạn với điều kiện là tổng số lần xuất hiện của từng người cho các công đoạn ngang ngang nhau. Tránh người làm nhiều quá, người làm ít quá.
Mong thầy cô và các anh chị giúp đỡ ạ.

Thử code này.

Sub abcd()
Dim Ten, sptT
Dim Congdoan, slN, sptCd
Dim Tam
Dim Kq, csD
Dim i, j, k, x, y, z
slN = 3
With Sheet1
    Congdoan = .Range("A6:A20")
    sptCd = UBound(Congdoan)
    Ten = .Range("F6:F9")
    sptT = UBound(Ten)
End With
ReDim csD(1 To sptCd)
For j = 1 To sptCd
    csD(j) = j
Next j
Randomize
z = sptCd
ReDim Kq(1 To sptCd, 1 To 1)
ReDim Tam(1 To slN)
For i = 1 To sptCd * slN
    j = ((i - 1) Mod sptT) + 1
    k = ((i - 1) Mod slN) + 1
    Tam(k) = Ten(j, 1)
    If k = slN Then
        x = (Rnd() * (z - 1) * 10 \ 10) + 1
        y = csD(x)
        csD(x) = csD(z)
        z = z - 1
        Kq(y, 1) = Replace(Join(Tam), " ", ", ")
    End If
Next i
With Sheet1
    .Range("B6").Resize(sptCd, 1).ClearContents
    .Range("B6").Resize(sptCd, 1) = Kq
End With
End Sub

 

[BuiQuangThuan]

Thử code này.

Cám ơn thầy ạ

 

[Ba Tê]

Cám ơn thầy ạ

Yêu cầu "ngẫu nhiên" làm chi rồi phải "tổng số lần xuất hiện của từng người cho các công đoạn ngang ngang nhau. " cho rắc rối.
Có 4 người thì cứ xếp theo thứ tự 1,2,3 - 2,3,4 - 3,4,1 - 4,1,2 ...

Public Sub s_Gpe()
Const R As Long = 15 '15 cong doan'
Dim Arr(1 To R, 1 To 1), tArr(), I As Long, J As Long, Dem As Long
    tArr = Range("F6:F9").Value '4 Ten'
    I = 1: J = 1
Do
    Arr(I, 1) = Arr(I, 1) & "-" & tArr(J, 1)
    Dem = Dem + 1
    J = J + 1
    If Dem = 3 Then
        Arr(I, 1) = Mid(Arr(I, 1), 2)
        I = I + 1
        Dem = 0
    End If
    If J > 4 Then J = 1
    If I > R Then Exit Do
Loop
Range("B6").Resize(R) = Arr
End Sub

 

[BuiQuangThuan]

Yêu cầu "ngẫu nhiên" làm chi rồi phải "tổng số lần xuất hiện của từng người cho các công đoạn ngang ngang nhau. " cho rắc rối.
Có 4 người thì cứ xếp theo thứ tự 1,2,3 - 2,3,4 - 3,4,1 - 4,1,2 ...

Public Sub s_Gpe()
Const R As Long = 15 '15 cong doan'
Dim Arr(1 To R, 1 To 1), tArr(), I As Long, J As Long, Dem As Long
    tArr = Range("F6:F9").Value '4 Ten'
    I = 1: J = 1
Do
    Arr(I, 1) = Arr(I, 1) & "-" & tArr(J, 1)
    Dem = Dem + 1
    J = J + 1
    If Dem = 3 Then
        Arr(I, 1) = Mid(Arr(I, 1), 2)
        I = I + 1
        Dem = 0
    End If
    If J > 4 Then J = 1
    If I > R Then Exit Do
Loop
Range("B6").Resize(R) = Arr
End Sub

Dạ. Đầu tiên cháu cứ nghĩ khó lên thành ra không minh mẫn. Ngồi lại thì thấy là có 15 công đoạn. 3 người 1 công đoạn. Tổng sẽ là 45. Có 4 người. Vậy mỗi người sẽ phải xuất hiện 11.25 lần. Cứ thế vẽ là ra. Nhưng dù sao các anh chị, chú bác trót giúp rồi. Thành ra cháu không giám rút lại. Cháu cám ơn mọi người ạ