excel - 我如何使用参数查看所有可能性

Question

我有3个工人。我需要进行流水线平衡。模型有10个操作。您可以在下表中查看所有工人的操作时间。他们有不同的能力。

所以我需要在 3 名工人之间共享所有操作。

所以我需要的是：模型的工人和操作是可变的。

20 名工人 - 25 次操作

18 工人 40 操作

19工人-75操作...

所以我需要为所有 i 定义参数。也许需要使用一个功能？

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

标签： excelvba

Answer 1

这听起来像是一个组合问题（顺序无关紧要）。

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

前：

后：

为每个列单元格展开列单元格