how can i see the all possibilities using parameters

Question

I have 3 workers. I need to make assembly line balancing. There are 10 operations of model. You can see the time of operations for all workers in the chart below. They have different abilities.

So I need to share all operations between 3 workers.

so what I need: Worker and operations of model is changeable.

20 worker-25 operations

18 worker-40 operations

19 worker-75 operations ...

So I need to define parameters for all i. Maybe need to use a function?

Sub rapor_calistir()
 Range("q1") = Now()
Sheets("Rapor").Range("A2:Z1048576").ClearContents
a = 2: worker1 = 0: worker2 = 0: worker3 = 0
For i1 = 1 To 3
    For i2 = 1 To 3
        For i3 = 1 To 3
            For i4 = 1 To 3
                For i5 = 1 To 3
                    For i6 = 1 To 3
                        For i7 = 1 To 3
                            For i8 = 1 To 3
                                For i9 = 1 To 3

                                        Sheets("Rapor").Cells(a, 1) = a - 1
                                        Sheets("Rapor").Cells(a, 2) = i1
                                        Sheets("Rapor").Cells(a, 3) = i2
                                        Sheets("Rapor").Cells(a, 4) = i3
                                        Sheets("Rapor").Cells(a, 5) = i4
                                        Sheets("Rapor").Cells(a, 6) = i5
                                        Sheets("Rapor").Cells(a, 7) = i6
                                        Sheets("Rapor").Cells(a, 8) = i7
                                        Sheets("Rapor").Cells(a, 9) = i8
                                        Sheets("Rapor").Cells(a, 10) = i9
                                        Sheets("Rapor").Cells(a, 11) = i10
                                        For i = 1 To 10
                                            ara_toplam = ara_toplam + WorksheetFunction.VLookup(i, Sheets("Data").Columns("A:D"), Sheets("Rapor").Cells(a, i + 1) + 1, False)
                                            If Sheets("Rapor").Cells(a, i + 1) = 1 Then
                                                worker1 = worker1 + WorksheetFunction.VLookup(i, Sheets("Data").Columns("A:D"), Sheets("Rapor").Cells(a, i + 1) + 1, False)
                                            ElseIf Sheets("Rapor").Cells(a, i + 1) = 2 Then
                                                worker2 = worker2 + WorksheetFunction.VLookup(i, Sheets("Data").Columns("A:D"), Sheets("Rapor").Cells(a, i + 1) + 1, False)
                                            ElseIf Sheets("Rapor").Cells(a, i + 1) = 3 Then
                                                worker3 = worker3 + WorksheetFunction.VLookup(i, Sheets("Data").Columns("A:D"), Sheets("Rapor").Cells(a, i + 1) + 1, False)
                                            End If
                                        Next i
                                        Sheets("Rapor").Cells(a, 12) = ara_toplam
                                        Sheets("Rapor").Cells(a, 13) = worker1
                                        Sheets("Rapor").Cells(a, 14) = worker2
                                        Sheets("Rapor").Cells(a, 15) = worker3
                                        ara_toplam = 0: worker1 = 0: worker2 = 0: worker3 = 0
                                        a = a + 1

                                    Next i10
                                Next i9
                            Next i8
                        Next i7
                    Next i6
                Next i5
            Next i4
        Next i3
    Next i2
Next i1
End Sub

Answer 1

This sounds like a combination problem (order doesn't matter).

Option Explicit

Sub main()
    Call for_each_in_others(rDATA:=Worksheets("Sheet1").Range("A2"), bHDR:=True)
End Sub

Sub for_each_in_others(rDATA As Range, Optional bHDR As Boolean = False)
    Dim v As Long, w As Long
    Dim iINCROWS As Long, iMAXROWS As Long, sErrorRng As String
    Dim vVALs As Variant, vTMPs As Variant, vCOLs As Variant

    On Error GoTo bm_Safe_Exit
    appTGGL bTGGL:=False

    With rDATA.Parent
        With rDATA(1).CurrentRegion
            'Debug.Print rDATA(1).Row - .Cells(1).Row
            With .Resize(.Rows.Count - (rDATA(1).Row - .Cells(1).Row), .Columns.Count).Offset(2, 0)
                sErrorRng = .Address(0, 0)
                vTMPs = .Value2
                ReDim vCOLs(LBound(vTMPs, 2) To UBound(vTMPs, 2))
                iMAXROWS = 1
                'On Error GoTo bm_Output_Exceeded
                For w = LBound(vTMPs, 2) To UBound(vTMPs, 2)
                    vCOLs(w) = Application.CountA(.Columns(w))
                    iMAXROWS = iMAXROWS * vCOLs(w)
                Next w

                'control excessive or no rows of output
                If iMAXROWS > Rows.Count Then
                    GoTo bm_Output_Exceeded
                ElseIf .Columns.Count = 1 Or iMAXROWS = 0 Then
                    GoTo bm_Nothing_To_Do
                End If

                On Error GoTo bm_Safe_Exit
                ReDim vVALs(LBound(vTMPs, 1) To iMAXROWS, LBound(vTMPs, 2) To UBound(vTMPs, 2))
                iINCROWS = 1
                For w = LBound(vVALs, 2) To UBound(vVALs, 2)
                    iINCROWS = iINCROWS * vCOLs(w)
                    For v = LBound(vVALs, 1) To UBound(vVALs, 1)
                        vVALs(v, w) = vTMPs((Int(iINCROWS * ((v - 1) / UBound(vVALs, 1))) Mod vCOLs(w)) + 1, w)
                    Next v
                Next w
            End With
        End With
        .Cells(2, UBound(vVALs, 2) + 2).Resize(1, UBound(vVALs, 2) + 2).EntireColumn.Delete
        If bHDR Then
            rDATA.Cells(1, 1).Offset(-1, 0).Resize(1, UBound(vVALs, 2)).Copy _
                Destination:=rDATA.Cells(1, UBound(vVALs, 2) + 2).Offset(-1, 0)
        End If
        rDATA.Cells(1, UBound(vVALs, 2) + 2).Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs
    End With

    GoTo bm_Safe_Exit
bm_Nothing_To_Do:
    MsgBox "There is not enough data in  " & sErrorRng & " to perform expansion." & Chr(10) & _
           "This could be due to a single column of values or one or more blank column(s) of values." & _
            Chr(10) & Chr(10) & "There is nothing to expand.", vbInformation, _
           "Single or No Column of Raw Data"
    GoTo bm_Safe_Exit
bm_Output_Exceeded:
    MsgBox "The number of expanded values created from " & sErrorRng & _
           " (" & Format(iMAXROWS, "\> #, ##0") & " rows × " & UBound(vTMPs, 2) & _
           " columns) exceeds the rows available (" & Format(Rows.Count, "#, ##0") & ") on this worksheet.", vbCritical, _
           "Too Many Entries"
bm_Safe_Exit:
    appTGGL
End Sub

Sub appTGGL(Optional bTGGL As Boolean = True)
    Application.EnableEvents = bTGGL
    Application.ScreenUpdating = bTGGL
End Sub

Before:

After:

Expanding column cells for each column cell