Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1164to1168
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

gleiche Verteilung von Lasten

gleiche Verteilung von Lasten
Lasten
Hallo zusammen,
irgendwie finde ich keinen Weg für folgendes Problem und hoffe mal wieder auf eure Hilfe.
Ich habe 8 Gewichte:
39 kg
19 kg
18 kg
16 kg
13 kg
13 kg
6 kg
4 kg
diese sollen auf drei Körbe so aufgeteilt werden, dass die Körbe möglichst gleiche Lasten haben.
Habt Ihr 'ne Idee?
Grüße
Christian

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

Betreff
Benutzer
Anzeige
ich würde es so verteilen ... ;o)
08.07.2010 10:27:02
Matthias
Hallo
da das schon optisch nur so einlädt ;o)
Korb1: 39+4
Korb2: 16+13+13
Korb3: 19+18+6
Userbild
Gruß Matthias
AW: gleiche Verteilung von Lasten
08.07.2010 11:54:28
Lasten
Hallo Christian,
grundsätzlich funzt es:
Option Explicit Function dec2bin(ByVal lngZahl As Long) As String If lngZahl > 0 Then dec2bin = dec2bin(lngZahl \ 2) & IIf(lngZahl Mod 2, "1", "0") End Function Sub gewichte() Dim i, j Dim w(8) As Byte Dim Ergebnis As Double, Mittelwert As Double, z As Byte Dim Faktor As String Sheets("Tabelle1").Cells.Clear w(1) = 38 w(2) = 11 w(3) = 18 w(4) = 15 w(5) = 15 w(6) = 13 w(7) = 6 w(8) = 4 z = 1 abw = 0 For i = 1 To 8 Mittelwert = Mittelwert + w(i) Cells(i, 1) = "Wert" & i Next Cells(9, 1) = "Ergebnis" Mittelwert = Round(Mittelwert / 3) While z Schau mal, ob das grundsätzlich zu deinem Problem passt, dann kann man ggf. noch dran basteln.
Gruß
David
Anzeige
AW: gleiche Verteilung von Lasten
08.07.2010 16:22:11
Lasten
Hallo David,
vielen dank für das Script - das sieht wirklich gut aus.
Bei den von mir genannten Zahlen funktioniert das auch gut.
Wenn ich das aber zum Beispiel mit:
w(1) = 46
w(2) = 23
w(3) = 22
w(4) = 17
w(5) = 15
w(6) = 14
w(7) = 8
w(8) = 6
laufen lasse erhält man:

Wert1		46
Wert2			23
Wert3	22
Wert4			17
Wert5			15
Wert6	14
Wert7	8
Wert8	6
Ergeb	50	46	55

erwartet hätte ich aber:
Wert1	46
Wert2		23
Wert3			22
Wert4		17
Wert5			15
Wert6			14
Wert7		8
Wert8	6
Ergeb	52	48	51
kannst du dir das erklären?
viele Grüße
Christian
Anzeige
AW: gleiche Verteilung von Lasten (noch offen o.T)
08.07.2010 16:24:09
Lasten
AW: gleiche Verteilung von Lasten (noch offen o.T)
09.07.2010 07:37:35
Lasten
Hallo Christian,
gegen den Profi-Code von Erich hab ich mit meinen beschränkten VBA-Kenntnissen keine Chance. Nimm seine Lösung.
Die Abweichung bei mir kommt daher, dass in der ersten Schleife alle Werte genommen werden, die am dichtesten am theoretischen Mittelwert liegen und falls dies nicht reicht anschließend die Abweichung vom Mittelwert immer größer angenommen wird. Was aber nicht berücksichtigt ist, wenn eine höhere Abweichung am Anfang dazu führt, dass die folgenden Abweichungen geringer werden.
Im Prinzip wollte ich das auch so ähnlich wie Erich machen, habe das allerdings nicht in VBA umsetzen können.
Gruß
David
Anzeige
gleiche Verteilung von Lasten
09.07.2010 00:51:44
Lasten
Hi Christian,
exakt dein Ergebnis kommt hier raus:
 ABCD
1GewichteKorb1Korb2Korb3
24646  
323 23 
422  22
517 17 
615  15
714  14
88 8 
966  
10    
11Summen:524851


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Die Prozedur dazu:

Option Explicit
Sub VerteileGleichm()
Dim w, ii As Long, strX As String, dblAbw As Double, ss As Long
Dim arrK(1 To 8) As Long, arrE(1 To 8) As Double, sumK(2) As Double
Dim dblMw As Double, dblMin As Double
w = Application.Transpose(Cells(2, 1).Resize(8)) ' Werte aus A2:A9
dblMin = 1E+308
dblMw = Application.Sum(w) / 3#
For ii = 0 To 1457
strX = Right("0000000" & Dez2ZSys(ii, 3), 8)
Erase sumK
For ss = 1 To 8
arrK(ss) = Mid(strX, ss, 1)
sumK(arrK(ss)) = sumK(arrK(ss)) + w(ss)
Next ss
'     dblAbw = Abs(dblMw - sumK(0)) + _
Abs(dblMw - sumK(1)) + _
Abs(dblMw - sumK(2))    ' Abw. vom Mittelwert
dblAbw = (dblMw - sumK(0)) ^ 2 + _
(dblMw - sumK(1)) ^ 2 + _
(dblMw - sumK(2)) ^ 2   ' quadrat. Abw. vom Mittelwert
If dblMin > dblAbw Then
dblMin = dblAbw
For ss = 1 To 8
arrE(ss) = arrK(ss)
Next ss
End If
Next ii
Cells(2, 2).Resize(8, 3).ClearContents
For ss = 1 To 8
Cells(ss + 1, 1) = w(ss)
Cells(ss + 1, arrE(ss) + 2) = w(ss)
Next ss
Cells(ss + 2, 2).Resize(, 3).Formula = "=SUM(B2:B9)"
End Sub
Function Dez2ZSys(ByVal dd As Double, bas As Integer) As String
Dim ss As Double, nn As Integer
If bas = ss * bas
ss = ss * bas
Wend
While ss >= 1
nn = dd \ ss
dd = dd - nn * ss
Dez2ZSys = Dez2ZSys & Chr(nn + 48 - 7 * (nn > "9"))
ss = ss / bas
Wend
End Function
Bei der Berechnung der Abweichung dblAbw habe ich die erste Version (Abw. vom Mittelwert)
als Kommentar stehen gelassen. Bessere Ergebnisse liefert die quadratische Abweichung.
Und hier noch eine Bei-Spiel-Mappe: https://www.herber.de/bbs/user/70504.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
Optimale Verteilung variabler
09.07.2010 10:33:03
Erich
Hi Christian,
hier eine neue Version, bei der man die Zahl der Körbe in A1 von 2 bis 7 wählen kann.
Die Gewichte (max. 15) werden aus Spalte A (ab A2 abwärts) gelesen.
Achtung: Bei "vielen" Gewichten und gleichzeitig "vielen" Körben kann das seeeeeeehr lange laufen...
https://www.herber.de/bbs/user/70509.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Optimale Verteilung - optimal - vielen Dank
09.07.2010 13:02:58
Christian
Hallo Erich,
whow...das ist echt Klasse.
Vielen Dank - auch an David.
Christian

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige