Variabilisierung der Packstücke beim Rucksackprobl

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi,
ok, ich habe angenommen, dass es sich bei einer derartigen Fragestellung um eine generelle Routine handelt, in der Art wie P(i) über i=1 bis n, wobei n eben variabel ist.
Aber hier mal der code: (handelt sich hierbei um die b-Version aus dem Entwicklungsstadium, aber prinzipiell gleicher Aufbau)

Sub Planung_Hauptprodukt()
Dim limit As Double, weight As Double, value As Double, totalWeight As Double, maximumValue As  _
Double, anlegermax As Double, anleger As Double
Dim a, b, c, d, e, f, g, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z  As Integer
Dim weighta, weightb, weightc, weightd, weighte, weightf, weightg, weighti, weightj, weightk,  _
weightl,
weightm, weightn, weighto, weightp, weightq, weightr, weights, weightt, weightu, weightv,  _
weightw, weightx, weighty, weightz As Double
Dim valuea, valueb, valuec, valued, valuee, valuef, valueg, valuei, valuej, valuek, valuel,  _
valuem,
valuen, valueo, valuep, valueq, valuer, values, valuet, valueu, valuev, valuew, valuex, valuey,  _
valuez As Double
Dim anlegera, anlegerb, anlegerc, anlegerd, anlegere, anlegerf, anlegerg, anlegeri, anlegerj,  _
anlegerk,
anlegerl, anlegerm, anlegern, anlegero, anlegerp, anlegerq, anlegerr, anlegers, anlegert,  _
anlegeru, anlegerv, anlegerw, anlegerx, anlegery, anlegerz As Double
Range("N10").value = 0
Range("B28").value = 0
Range("B30").value = 0
Range("B7").value = 0
Range("B9").value = 0
Range("B26:V26").value = 0
limit = Range("D7").value
anlegermax = Range("D11").value
maximumValue = 0
Range("G10").value = "... bitte warten"
weighti = Range("B2").value
weightj = Range("C2").value
weightk = Range("D2").value
weightl = Range("E2").value
weightm = Range("F2").value
weightn = Range("G2").value
weighto = Range("H2").value
weightp = Range("I2").value
weightq = Range("J2").value
weightr = Range("K2").value
weights = Range("L2").value
weightt = Range("M2").value
weightu = Range("N2").value
weightv = Range("O2").value
weightw = Range("P2").value
weightx = Range("Q2").value
weighty = Range("R2").value
weightz = Range("S2").value
weighta = Range("T2").value
weightb = Range("U2").value
weightc = Range("V2").value
weightd = Range("W2").value
weighte = Range("X2").value
weightf = Range("Y2").value
weightg = Range("Z2").value
valuei = Range("B4").value
valuej = Range("C4").value
valuek = Range("D4").value
valuel = Range("E4").value
valuem = Range("F4").value
valuen = Range("G4").value
valueo = Range("H4").value
valuep = Range("I4").value
valueq = Range("J4").value
valuer = Range("K4").value
values = Range("L4").value
valuet = Range("M4").value
valueu = Range("N4").value
valuev = Range("O4").value
valuew = Range("P4").value
valuex = Range("Q4").value
valuey = Range("R4").value
valuez = Range("S4").value
valuea = Range("T4").value
valueb = Range("U4").value
valuec = Range("V4").value
valued = Range("W4").value
valuee = Range("X4").value
valuef = Range("Y4").value
valueg = Range("Z4").value
For i = 0 To 1
For j = 0 To 1
For k = 0 To 1
For l = 0 To 1
For m = 0 To 1
For n = 0 To 1
For o = 0 To 1
For p = 0 To 1
For q = 0 To 1
For r = 0 To 1
For s = 0 To 1
For t = 0 To 1
For u = 0 To 1
For v = 0 To 1
For w = 0 To 1
For x = 0 To 1
For y = 0 To 1
For z = 0 To 1
For a = 0 To 1
For b = 0 To 1
For c = 0 To 1
For d = 0 To 1
For e = 0 To 1
For f = 0 To 1
For g = 0 To 1
_
weight = weighti * i + weightj * j + weightk * k + weightl * l + weightm * m + weightn * n +
weighto * o + weightp * p + weightq * q + weightr * r + weights * s + weightt * t + weightu * u  _
weightv * v + weightw * w + weightx * x + weighty * y + weightz * z + weighta * a + weightb * b  _
weightc * c + weightd * d + weighte * e + weightf * f + weightg * g
value = valuei * i + valuej * j + valuek * k + valuel * l + valuem * m + valuen * n + valueo *  _
o +
valuep * p + valueq * q + valuer * r + values * s + valuet * t + valueu * u + valuev * v +
valuew * w + valuex * x + valuey * y + valuez * z + valuea * a + valueb * b + valuec * c +
valued * d + valuee * e + valuef * f + valueg * g
anleger = i + j + k + l + m + n + o + p + q + r + s + t + u + v + w + x + y + z + a + b + c
+ d + e + f + g
If value > maximumValue And weight

Hallo
ich hab es mir nicht angesehen...
Nur eine Aussage zu DIM:
Dim a, b, c, d, e, f, g, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z As Integer
hier wird nur Z als Integer deklariert
Alle Anderen davor als Variant

das gleiche weiter darunter

Dim limit As Double, weight As Double, value As Double, totalWeight As Double, maximumValue As   _
_
Double, anlegermax As Double, anleger As Double

ist Richtig
aber value als Variable würde ich nicht verwenden; ist Bestandteil der Pogrammiersprache
Du kannst aber Abkürzungen verwenden
Dim limit#, weight#, value#, totalWeight#, maximumValue#, anlegermax#, anleger#
Dim a%, b%, c%, d%, e%, f%, g%, i%, j%, k%, l%, m%, n%, o%, p%, q%, r%, s%, t%, u%, v%, w%, x%, y%, z%
siehe z.B. https://docs.microsoft.com/de-de/dotnet/visual-basic/programming-guide/language-features/data-types/type-characters

Und warum läuft das Ganze dann?
Weil es auf mit variant auch läuft
LG UweD

Option Explicit Dim count Type Result Items As String Value As Long Weight As Long End Type Dim FinalResult As Result, Limit As Long, anz As Long, g() As Long, rw As Long Sub Autput(r As Result) rw = rw + 1 If r.Value > 0 Then Cells(rw, 1) = r.Items Else Cells(rw, 1) = "(" + r.Items + ")" 'Verworfen End If Cells(rw, 2) = r.Value Cells(rw, 3) = r.Weight End Sub Function EvaluateCombi(s As String) As Result Dim r As Result, n As Integer, i As Integer r.Items = s r.Value = 0 r.Weight = 0 For n = 1 To Len(s): i = Asc(Mid(s, n, 1)) - 64: r.Value = r.Value + g(i, 0): r.Weight = r. _ Weight + g(i, 1): Next If r.Weight > Limit Then r.Value = -1 EvaluateCombi = r End Function Sub Combi(ByVal Cur As String, ByVal Wk As String) Dim i As Integer, r As Result i = 0 While i FinalResult.Value) Or ((r.Value = FinalResult.Value) And (r.Weight 0) Then Autput r Combi Cur + Mid(Wk, i, 1), Mid(Wk, i + 1) 'Left(Wk, i - 1) + Mid(Wk, i + 1) Wend End Sub Sub AlleKombinationen() Dim n As Integer, s As String, rws As Long Limit = Range("Limit") anz = Range("Güter").Rows.count ReDim g(anz, 1): s = "" For n = 1 To anz: s = s + Range("Güter").Cells(n, 1): g(n, 0) = Range("Güter").Cells(n, 2): g( _ n, 1) = Range("Güter").Cells(n, 3): Next rw = Range("Limit").Cells(1, 1).Row + 1: Range(Cells(rw, 1), Cells(5000, 3)).ClearContents: _ rw = rw + 1 rws = rw Cells(rw, 1) = "Kombi": Cells(rw, 2) = "Wert": Cells(rw, 3) = "Gewicht" count = 0: FinalResult.Items = "": FinalResult.Value = 0: FinalResult.Weight = 0 Combi "", s Range(Cells(rws, 1), Cells(rw - 1, 3)).Sort Key1:=Range("B13"), Order1:=xlDescending, Key2:= _ Range("C13"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom rw = rw + 1: Autput FinalResult: rw = rw + 1: Cells(rw, 1) = count End Sub

Sub knapsack() Dim Objekt Dim Gewicht Dim Wert Dim Anz As Long Dim limAnzahl As Long Dim limGewicht As Double Dim sumAnzahl As Long Dim sumGewicht As Double Dim sumWert As Double Dim ergWert As Double Dim ergGewicht As Double Dim ergID As Double Dim ID As Double Dim x As Double Dim i As Long, n As Long limAnzahl = Range("D11").Value ' Maxmiale Anzah an Ojekten im Ergebnis limGewicht = Range("D7").Value ' zulässsiges Gewicht Anz = 8 'Anzahl der vorhandenen Objekte ReDim Gewicht(Anz - 1) As Double ReDim Wert(Anz - 1) As Double For i = 0 To Anz - 1 Gewicht(i) = Range("B2").Offset(0, i).Value Wert(i) = Range("B4").Offset(0, i).Value Next For ID = 1 To 2 ^ Anz - 1 If ID = 7 Then Stop sumGewicht = 0 sumWert = 0 sumAnzahl = 0 For n = 0 To Anz - 1 x = 2 ^ n If (ID And x) = x Then sumGewicht = sumGewicht + Gewicht(n) sumWert = sumWert + Wert(n) sumAnzahl = sumAnzahl + 1 End If Next If sumGewicht ergWert Then ergWert = sumWert ergGewicht = sumGewicht ergID = ID End If End If End If Next ID For i = 0 To Anz - 1 Range("B5").Offset(0, i).Value = -1 * ((ergID And 2 ^ i) = 2 ^ i) Next Range("B7").Value = ergGewicht Range("B9").Value = ergWert End Sub

Sub ProblemErzeugen() Dim n As Long, i As Long, z As Long, ok As Boolean Dim zz1() As Long, zz2() As Long Workbooks.Add Cells(1, 1) = "Name": Cells(1, 2) = "Wert": Cells(1, 3) = "Gewicht" n = 55 ReDim zz1(n): For i = 1 To n: zz1(i) = i: Next ReDim zz2(n): For i = 1 To n: zz2(i) = i: Next For i = 1 To n Cells(i + 1, 1) = Chr(i + 64) Do z = Int(Rnd * n) + 1 ok = zz1(z) > 0 If ok Then zz1(z) = -1 Loop Until ok Cells(i + 1, 2) = z * 5 Do z = Int(Rnd * n) + 1 ok = zz2(z) > 0 If ok Then zz2(z) = -1 Loop Until ok Cells(i + 1, 3) = z * 100 Next Range(Cells(2, 1), Cells(n + 1, 3)).Name = "Güter" Cells(n + 3, 1) = "Limit": Cells(n + 3, 2) = (n + 5) * 100: Cells(n + 3, 2).Name = "Limit" Cells(n + 4, 1) = "Anzahl": Cells(n + 4, 2) = n: Cells(n + 4, 2).Name = "Anzahl" End Sub

Option Explicit Type Result Items As String Value As Long Weight As Long End Type Dim FinalResult As Result, Limit As Long, Anz As Long, g() As Long, rw As Long, count As Double Sub Autput(r As Result) rw = rw + 1 If r.Value > 0 Then Cells(rw, 1) = r.Items Else Cells(rw, 1) = "(" + r.Items + ")" 'Verworfen End If Cells(rw, 2) = r.Value Cells(rw, 3) = r.Weight End Sub Function EvaluateCombi(s As String) As Result Dim r As Result, n As Integer, i As Integer r.Items = s r.Value = 0 r.Weight = 0 For n = 1 To Len(s): i = Asc(Mid(s, n, 1)) - 64: r.Value = r.Value + g(i, 0): r.Weight = r. _ Weight + g(i, 1): Next If r.Weight > Limit Then r.Value = -1 EvaluateCombi = r End Function Sub Combi(ByVal Cur As String, ByVal Wk As String) Dim i As Integer, r As Result i = 0 While i FinalResult.Value) Or ((r.Value = FinalResult.Value) And (r.Weight 0) Then Combi Cur + Mid(Wk, i, 1), Mid(Wk, i + 1): 'Autput r 'nur dann in die _ nächste Iteration, wenn das Limit noch nicht überschritten ist Wend End Sub Sub AlleKombinationen() '2^n-1 Dim n As Integer, s As String, rws As Long Dim t As Date Limit = Range("Limit") Anz = Range("Anzahl") 'Range("Güter").Rows.count ReDim g(Anz, 1): s = "" For n = 1 To Anz: s = s + Range("Güter").Cells(n, 1): g(n, 0) = Range("Güter").Cells(n, 2): g( _ n, 1) = Range("Güter").Cells(n, 3): Next rw = Range("Limit").Cells(1, 1).Row + 2: Range(Cells(rw, 1), Cells(5000, 3)).ClearContents: _ rw = rw + 1 rws = rw Cells(rw, 1) = "Kombi": Cells(rw, 2) = "Wert": Cells(rw, 3) = "Gewicht" Application.ScreenUpdating = False: t = Now() count = 0: FinalResult.Items = "": FinalResult.Value = 0: FinalResult.Weight = 0 Combi "", s ' Range(Cells(rws, 1), Cells(rw - 1, 3)).Sort Key1:=Range("B13"), Order1:=xlDescending, Key2:= _ Range("C13"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom rw = rw + 1: Autput FinalResult: Cells(rw + 1, 1) = count: Cells(rw + 2, 1) = Now() - t: _ Cells(rw + 2, 1).NumberFormat = "mm:ss" Application.ScreenUpdating = True Application.StatusBar = False End Sub

Beliebteste Forumthreads (12 Monate)

Variabilisierung der Packstücke beim Rucksackprobl

26 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread