Sinnvollste Kombination wählen

Hallo zusammen,
in der beigefügten Datei möchte ich Aufsätze nach Eingabe der Länge in C1 wählen.
Die Ausgabe erfolgt in C4:C7.
Die einzelnen Aufsätze haben eine feste Länge (siehe H1:H4).
Nun soll die Excel die "sinnvollste" Kombination aus den vorhandenen Aufsätzen wählen.
Derzeit funktioniert die Datei auch. Ich hab das ganz über Select Case gelöst.
Leider ist das ganze nicht intuitiv, sondern "hard coded".
Kann man das ganze schöner lösen? Ohne alle verschiedenen Varianten 1-17 in diesem Fall durchzugehen.
Dadurch entstehen natürlich sehr viele Zeilen.
Vielen Dank schon einmal für die Unterstützung :)
Grüße
Peter
UPLOAD DER DATEI ist nicht möglich?


Sub auswahl()
Select Case ActiveSheet.Range("C1")
Case "15": ActiveSheet.Range("C4").Value = "A-1"
ActiveSheet.Range("C5").Value = "A-1.3"
ActiveSheet.Range("C6").Value = "A-1.3"
ActiveSheet.Range("C7").Value = "A-1.4"
ActiveSheet.Range("D4").Value = "2"
ActiveSheet.Range("D5").Value = "4"
ActiveSheet.Range("D6").Value = "4"
ActiveSheet.Range("D7").Value = "5"
Case "16": ActiveSheet.Range("C4").Value = "A-1"
ActiveSheet.Range("C5").Value = "A-1.3"
ActiveSheet.Range("C6").Value = "A-1.4"
ActiveSheet.Range("C7").Value = "A-1.4"
ActiveSheet.Range("D4").Value = "2"
ActiveSheet.Range("D5").Value = "4"
ActiveSheet.Range("D6").Value = "5"
ActiveSheet.Range("D7").Value = "5"
Case "10": ActiveSheet.Range("C4").Value = "A-1"
ActiveSheet.Range("C5").Value = "A-1.3"
ActiveSheet.Range("C6").Value = "A-1.3"
ActiveSheet.Range("C7").Value = ""
ActiveSheet.Range("D4").Value = "2"
ActiveSheet.Range("D5").Value = "4"
ActiveSheet.Range("D6").Value = "4"
ActiveSheet.Range("D7").Value = ""
End Select
End Sub

Eingabe
Länge: 15 [m] (1 - 17 [m] )
Ausgabe Kombination
Aufsatz 1 A-1 -> 2
Aufsatz 2 A-1.3 -> 4
Aufsatz 3 A-1.3 -> 4
Aufsatz 4 A-1.4 -> 5

Beispiele Ausgabe KOmbination

Länge 10
A-1. -> 2
A-1.3 -> 4
A-1.3. -> 4
11 2 A-1 -> 2
5 A-1.4. -> 5
4 A-1.3. -> 4
13 2 A-1 -> 2
2 A-1.2 -> 2
5 A-1.4 -> 5
4 A-1.3 -> 4
Inventar:
A-1 ->2 [m] immer
A-1.2 ->2 [m] variabel
A-1.3 ->4 [m] variabel
A-1.4 ->5 [m] variabel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Const cInfos = _ "10;2:A-1;4:A-1.3;4:A-1.3|" & _ "11;2:A-1;5:A-1.4;4:A-1.3|" & _ "12;2:A-1;5:A-1.4;5:A-1.4|" & _ "13;2:A-1;2:A-1.2;5:A-1.4;4:A-1.3|" & _ "15;2:A-1;4:A-1.3;4:A-1.3;5:A-1.4|" Sub auswahl() Dim L, A, i Dim Länge As Long Dim Ausgabe(1 To 4, 1) As String On Error Resume Next Länge = ActiveSheet.Range("C1") For Each L In Split(cInfos, "|") A = Split(L, ";") If Länge = A(0) Then For i = 1 To UBound(Ausgabe(0)) Ausgabe(i, 0) = Split(A(i), ":")(0) Ausgabe(i, 1) = Split(A(i), ":")(1) Next Exit For End If Next ActiveSheet.Range("C4:D7") = Ausgabe End Sub

Sub Aufteilen() Dim Länge As Long Dim Erg As String Dim Ausgabe() Dim tmpArr Dim i, S Const cLängeAusgabe = 4 Länge = ActiveSheet.Range("C1") - 2 Do While Länge > 0 And i = 5 Erg = Erg & "|5:A-1.4" Länge = Länge - 5 Case Is = 4 Erg = Erg & "|4:A-1.3" Länge = Länge - 4 Case Is = 2 Erg = Erg & "|2:A-1.2" Länge = Länge - 2 End Select i = i + 1 Loop Erg = Mid(Erg, 2) & "|2:A-1" 'immer drin tmpArr = Split(Erg, "|") i = UBound(tmpArr) ReDim Ausgabe(cLängeAusgabe - 1, 1) For Each S In tmpArr Ausgabe(i, 0) = Split(S, ":")(1) Ausgabe(i, 1) = CInt(Split(S, ":")(0)) i = i - 1 Next ActiveSheet.Range("C4").Resize(cLängeAusgabe, 2) = Ausgabe End Sub

Sub Aufteilen() Dim Länge As Long Dim Erg As String Dim tmpArr Dim i As Long Länge = ActiveSheet.Range("C1") - 2 Do While Länge > 0 And i = 5 Erg = Erg & "|5:A-1.4" Länge = Länge - 5 Case Is = 4 Erg = Erg & "|4:A-1.3" Länge = Länge - 4 Case Is = 2 Erg = Erg & "|2:A-1.2" Länge = Länge - 2 End Select i = i + 1 Loop Erg = Mid(Erg, 2) & "|2:A-1" 'immer drin tmpArr = Split(Erg, "|") ActiveSheet.Range(Range("B4"), ActiveSheet.Range("D9999").End(xlUp)).ClearContents For i = 0 To UBound(tmpArr) ActiveSheet.Range("B4").Offset(UBound(tmpArr) - i, 0) = "Aufsatz " & UBound(tmpArr) - i + 1 ActiveSheet.Range("B4").Offset(UBound(tmpArr) - i, 1) = Split(tmpArr(i), ":")(1) ActiveSheet.Range("B4").Offset(UBound(tmpArr) - i, 2) = Split(tmpArr(i), ":")(0) Next End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread