Einbauvarianten

[toeg]

Hallo liebe Excel Freunde
 
Ich habe folgende Aufgabe/Herausforderung:
 
Welche verschiedenen Möglichkeiten gibt es, die Schubladen (50mm, 75mm, 100mm, 125mm, 150mm, 200mm, 250mm, 300mm) in das Gehäuse (550mm) einzubauen. Gibt es im Excel eine Formel, die mir das ausrechnet und alle Varianten zeigt? Es spielt keine Rolle wo die einzelnen Schubladen im Gehäuse angeordnet sind.
 
Ohne geeignete Formel müsste ich jede einzelne Variante aufschreiben.
 
Bsp.:    3
300mm + 250mm
300mm + 200mm + 50mm
300mm + 150mm + 100mm
300mm + 150mm + 50mm + 50m
300mm + 125mm + 125mm
300mm + 125mm + 75mm + 50mm
 
Vielen Dank für eure Hilfe

[Fennek]

Hallo,

hier ist ein Verschlag:

Code:

Sub toeg()
Dim F(6)
Ar = Array(50, 75, 100, 125, 150, 250, 300)
Ziel = 550 '<<<<<<<<< hier den Zielwert eingeben >>>>>>>>>>>>>
For i = 0 To 127
   For j = 0 To 6
       F(j) = IIf((2 ^ j And i) > 0, 1, 0)
       'Debug.Print i, F(j)
   Next j

If WorksheetFunction.SumProduct(Ar, F) = Ziel Then
   Ausgabe = ""
   For k = 0 To 6
       If F(k) <> 0 Then Ausgabe = Ausgabe & Ar(k) & " + "
   Next k
   Debug.Print Left(Ausgabe, Len(Ausgabe) - 3)
End If
Next i
End Sub

Eventuell ist es nötig darauf hinzuweisen, dass die Ausgabe ins VBA-Direktfenster erfolgt.


Ein feedback wäre nett.

mfg

[Gast 123]

Hallo,

selbstverständlich kann man eine vollständige Übersicht über alle Möglichkeiten erstellen.  Ich nehme an es geht um Elektronik Einschübe im 19 Zoll Gehäuse oder ähnliches.  Wäre mir als alter Praktiker zu unübersichtlich, zu aufwendig.  

Meine Empfehlung:  in einer Excel Tabelle in Zelle A1 die Grösse eingeben, in Zelle A2 eine Summenformel ab A4 nach unten, und dann ab A4 die Schubladen mit der grössten zuerst eintragen.  Rechts in C2 Subtraction wieviel als Rest noch übrig bleibt.  Und Formatiere die Zelle C2 auf Rot für Negativ Zahlen.

mfg  Gast 123 

550  Grösse      Rest     (550 als feste Eingabe)
550  Einschub        0    (550 über Summenformel)

300  Schublade 1
125  Schublade 2
75
50

[schauan]

Hallo Fennek,

Dein Code bringt mir nur 5 Ergebnisse?

75 + 100 + 125 + 250
50 + 100 + 150 + 250
50 + 75 + 125 + 300
100 + 150 + 300
250 + 300

Die Lösungen haben bis zu 11 Summanden (11 x 50) Wie ich darauf komme? In dieser Lösung des TE gibt es die 50er 2x:
300mm + 150mm + 50mm + 50m
Da nicht festgelegt ist, wie oft es jede Schublade gibt und im Beispiel schon eine 2x vorkommt, vermute ich, dass der TE ausreichend Schubladen hat

Allerdings gehe ich auch noch davon aus, dass 50m ein Schreibfehler ist und nicht eine entsprechend breite Schublade zurecht gestaucht wird

[Fennek]

Hallo Schaun,


klares Argument, das ich nicht berücksichtigt habe. Mal sehen, ob mir dazu noch etwas einfällt.

mfg

[Fennek]

Hallo André,

nachts bin ich am kreativsten.

Da es m.M.n. nicht möglich ist, mit vertretbarem Aufwand alle Möglichkeiten durch zu probieren, hatte ich eine andere Idee:

Mein kleiner Code muss ergänzt werden mit der Berücksichtigung ganzzahliger Vielfache:

50mm, 75mm, 100mm, 125mm, 150mm, 200mm, 250mm, 300mm


Da
300 = 250 + 50
250 = 200 + 50
200 = 150 + 50
150 = 100 + 50
150 =  75 + 75
100 =  50 + 50

muss, soweit möglich, jede gefunden Möglichkeit noch einmal aufgeteilt werden.

Sollte einfach machbar sein, aber ich werde es nicht programmieren.

mfg

[BoskoBiati]

Hallo,

ist auch einfach, aber etwas Schreibarbeit:

Code:

Sub Kombi()
Dim loA300 As Long
Dim loA250 As Long
Dim loA200 As Long
Dim loA150 As Long
Dim loA125 As Long
Dim loA100 As Long
Dim loA75 As Long
Dim loA50 As Long
Dim lob As Long
Dim strSchub As String
Dim varBr(7) As Variant
Dim arrBr As Variant
Dim loletzte As Long
loletzte = Cells(Rows.Count, 1).End(xlUp).Row
arrBr = Array(300, 250, 200, 150, 125, 100, 75, 50)
For lob = 0 To 7
varBr(lob) = arrBr(lob)
Next
For loA300 = 0 To 1
    For loA250 = 0 To 1
        For loA200 = 0 To 2
            For loA150 = 0 To 3
                For loA125 = 0 To 4
                    For loA100 = 0 To 5
                        For loA75 = 0 To 7
                            For loA50 = 0 To 11
                                If loA300 * varBr(0) + loA250 * varBr(1) + loA200 * varBr(2) + loA150 * varBr(3) + loA125 * varBr(4) + loA100 * varBr(5) + loA75 * varBr(6) + loA50 * varBr(7) = 550 Then
                                    If loA300 <> 0 Then
                                            strSchub = loA300 & "x " & varBr(0) & "mm, "
                                    End If
                                    If loA250 <> 0 Then
                                            strSchub = strSchub & loA250 & "x " & varBr(1) & "mm,"
                                    End If
                                    If loA200 <> 0 Then
                                            strSchub = strSchub & loA200 & "x " & varBr(2) & "mm,"
                                    End If
                                    If loA150 <> 0 Then
                                            strSchub = strSchub & loA150 & "x " & varBr(3) & "mm,"
                                    End If
                                    If loA125 <> 0 Then
                                            strSchub = strSchub & loA125 & "x " & varBr(4) & "mm,"
                                    End If
                                    If loA100 <> 0 Then
                                            strSchub = strSchub & loA100 & "x " & varBr(5) & "mm,"
                                    End If
                                    If loA75 <> 0 Then
                                            strSchub = strSchub & loA75 & "x " & varBr(6) & "mm,"
                                    End If
                                    If loA50 <> 0 Then
                                            strSchub = strSchub & loA50 & "x " & varBr(7) & "mm,"
                                    End If
                                    Cells(loletzte, 1) = Left(strSchub, Len(strSchub) - 2)
                                    loletzte = loletzte + 1
                                    strSchub = ""
                                End If
                            Next
                         Next
                    Next
                Next
            Next
        Next
    Next
Next
                                    
End Sub

[BoskoBiati]

Hallo,

hier noch eine Tabellendarstellung der Kombinationen:

Code:

Sub Kombi2()
Dim rng As Range
Dim loA300 As Long
Dim loA250 As Long
Dim loA200 As Long
Dim loA150 As Long
Dim loA125 As Long
Dim loA100 As Long
Dim loA75 As Long
Dim loA50 As Long
Dim lob As Long
Dim strSchub As String
Dim varBr(7) As Variant
Dim arrBr As Variant
Dim loletzte As Long
ActiveSheet.UsedRange.ClearContents
arrBr = Array(300, 250, 200, 150, 125, 100, 75, 50)
For lob = 0 To 7
Cells(1, lob + 1) = arrBr(lob)
varBr(lob) = arrBr(lob)

loletzte = 2
Next
For loA300 = 1 To 0 Step -1
    For loA250 = 1 To 0 Step -1
        For loA200 = 2 To 0 Step -1
            For loA150 = 3 To 0 Step -1
                For loA125 = 4 To 0 Step -1
                    For loA100 = 5 To 0 Step -1
                        For loA75 = 7 To 0 Step -1
                            For loA50 = 11 To 0 Step -1
                                If loA300 * varBr(0) + loA250 * varBr(1) + loA200 * varBr(2) + loA150 * varBr(3) + loA125 * varBr(4) + loA100 * varBr(5) + loA75 * varBr(6) + loA50 * varBr(7) = 550 Then
                                    Cells(loletzte, 1) = loA300
                                    Cells(loletzte, 2) = loA250
                                    Cells(loletzte, 3) = loA200
                                    Cells(loletzte, 4) = loA150
                                    Cells(loletzte, 5) = loA125
                                    Cells(loletzte, 6) = loA100
                                    Cells(loletzte, 7) = loA75
                                    Cells(loletzte, 8) = loA50
                                    loletzte = loletzte + 1
                                End If
                            Next
                         Next
                    Next
                Next
            Next
        Next
    Next
Next
Set rng = Range("A1:H" & loletzte - 1)
With rng.Borders
    .LineStyle = xlThin
    .ColorIndex = 0
End With
End Sub

[Fennek]

Hallo Bosko,

sieht gut aus!

mfg