how can i see the all possibilities using parameters - excel

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