MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 10.09.2016, 22:03   #1
StevEiserman
Neuer Benutzer
Neuer Benutzer
Standard VBA - Optimierung Palettenauslastung

Hallo Excel Profis,
ich habe ein großes Problem und ich hoffe ihr mir helfen???!!!
Mein Chef hat mir eine Exceldatei (xlsm) zukommen lassen (Quelle keine Ahnung),
wo man die optimale Stappelung der unterschiedlichen Ware (Maße) auf einer
Europalette (120x80cm) berechnen kann und das Stapelmuster noch grafisch darstellt!!!
Leider funktioniert das nicht immer richtig, bei dem Beispielkarton 29x47cm zeigt das Tool
4 Kartons angeordnet Quer (29x47) und das wars, es würden aber normalerweise
noch 2 Kartons längs passen (47x29) (da ja 47cm (quer)+ 29cm (längs) ja 76cm ergibt
und somit unter 80cm ist.


Das lässt sich sehr schlecht beschreiben, das Beste ist Ihr ladet Euch das mal runter und
schaut euch das mal an, wirklich eine tolle Geschichte wenn es richtig funktioniert!!!!

Jetzt soll ich das Problem lösen,
ich habe nur ein wenig VBA-Kenntnisse und bin damit überfordert und baue hier voll auf Euch,
ich würde mich sehr Freuen wenn Ihr mir hier helfen könnt!!!!

Danke+
Gruß
StevEiserman



Code:

Option Explicit
  'calculated in GetTotalBoxCount()
  'used to draw boxes later
  Dim basicRowCount As Long
  Dim oddRowCount As Long       'will always be 0 or 1
  Dim basicColumnCount As Long
  Dim oddColumnCount As Long
  Dim TotalBoxesOnPallet As Long

Sub DrawOptimizedLayout()
  Const dataSheetName = "PalletPacking" ' name of sheet with data entries
  Const drawSheetName = "PalletPacking" ' name of sheet to place drawing on
  'these define where your values are on the sheet for the
  'pallet and box dimensions
  'these are cells on the dataSheetName sheet
  Const boxShortSideCell = "B1"
  Const boxLongSideCell = "B2"
  Const palletShortSideCell = "B3"
  Const palletLongSideCell = "B4"
  Const maxBoxCountCell = "B5"
  ' pick a cell to put upper left corner of pallet in
  ' remember that it will extend down and to the right
  ' covering about 5 columns and 19 rows (at standard size)
  'this is a cell on the drawSheetName sheet
  Const drawInCell = "D3"
  'this conversion factor will take the width/height values
  'and give a reasonable size for the drawing in inches
  'an 80cm x 120cm pallet draws out to 2.4 inches by 3.6 inches
  Const convFactor = 3
  'do not change the value of pointsPerInch!!
  Const pointsPerInch = 72 ' have to use points to size the shapes
 
  Dim palletWidth As Long
  Dim palletHeight As Long
  Dim boxWidth As Long
  Dim boxHeight As Long
  'for drawing the boxes
  Dim drawBoxWidth As Long
  Dim drawBoxHeight As Long
  'for testing layouts for best result
  Dim ResultLongWithLong As Long
  Dim ResultWideWithLong As Long
'*******************************
  Dim boxShortSide As Single   ' width in centimeters
  Dim boxLongSide As Single    ' height in centimeters
  Dim pDrawWidth As Single
  Dim pDrawHeight As Single
  Dim bDrawShortSide As Single
  Dim bDrawLongSide As Single
 
  Dim currentWS As Worksheet
  Dim dataWS As Worksheet
  Dim drawingWS As Worksheet
  Dim anyShape As Shape
 
  Dim curTop As Single
  Dim curLeft As Single
  Dim testWidth As Single
  Dim testHeight As Single
  Dim totalWidth As Single
  Dim totalHeight As Single
  Dim maxWidth As Single
  Dim try1 As Integer
  Dim try2 As Integer
  Dim maxBoxes As Integer
  Dim boxCount As Integer
  Dim rowCounter As Long
  Dim colCounter As Long
 
  Set currentWS = ActiveSheet ' so we can find our way back
  Set dataWS = ThisWorkbook.Worksheets(dataSheetName)
  Set drawingWS = ThisWorkbook.Worksheets(drawSheetName)
'*******************************
  With dataWS
    palletWidth = .Range(palletShortSideCell)
    palletHeight = .Range(palletLongSideCell)
    boxWidth = .Range(boxShortSideCell)
    boxHeight = .Range(boxLongSideCell)
  End With
  pDrawWidth = (palletWidth / 100) * convFactor * pointsPerInch
  maxWidth = pDrawWidth
  pDrawHeight = (palletHeight / 100) * convFactor * pointsPerInch
  bDrawShortSide = (boxShortSide / 100) * convFactor * pointsPerInch
  bDrawLongSide = (boxLongSide / 100) * convFactor * pointsPerInch
 
'validate that all dimensions are positive numbers greater than zero
  If palletWidth <= 0 _
   Or palletHeight <= 0 _
   Or boxWidth <= 0 _
   Or boxHeight <= 0 Then
    MsgBox "One or more dimensions for the pallet or boxes is invalid!", _
     vbOKOnly + vbCritical, "Aborting the Drawing Process"
    GoTo FinalExitAndCleanup
  End If
 
  'test for Method 1
  drawBoxHeight = boxHeight
  drawBoxWidth = boxWidth
  ResultLongWithLong = GetTotalBoxCount(palletWidth, palletHeight, boxHeight, boxWidth)
  'test for Method 2
  drawBoxHeight = boxWidth
  drawBoxWidth = boxHeight

  ResultWideWithLong = GetTotalBoxCount(palletWidth, palletHeight, boxWidth, boxHeight)
  'may need to reset up the values of
  '  TotalBoxesInBasicRows
  '  TotalBoxesInOddRow
  '  TotalBoxesOnPallet
  'this will set up the 3 values properly for drawing the layout
  dataWS.Range(maxBoxCountCell) = ResultWideWithLong
  If ResultLongWithLong > ResultWideWithLong Then
    dataWS.Range(maxBoxCountCell) = ResultLongWithLong
    drawBoxHeight = boxHeight
    drawBoxWidth = boxWidth
    ResultLongWithLong = GetTotalBoxCount(palletWidth, palletHeight, boxHeight, boxWidth)
  End If
  bDrawShortSide = (drawBoxWidth / 100) * convFactor * pointsPerInch
  bDrawLongSide = (drawBoxHeight / 100) * convFactor * pointsPerInch

  'delete any and all shapes on the sheet so we can start over
  With drawingWS
    'except we want to keep our TextBox that is named TextBoxDrawLayout
    For Each anyShape In .Shapes
      'Rectangles are .Type = 1
      'TextBox is .Type = 17
      If anyShape.Type = 1 Then
        anyShape.Delete
      End If
    Next
    'set up starting points for the drawing
    curTop = .Range(drawInCell).Top
    curLeft = .Range(drawInCell).Left
  End With
  'draw the pallet itself
  'the sheet it goes onto needs to be active
  drawingWS.Activate
  ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
   curLeft, curTop, pDrawWidth, pDrawHeight).Select

  'start drawing the smaller boxes
  curTop = drawingWS.Range(drawInCell).Top
  For rowCounter = 1 To basicRowCount
    curLeft = drawingWS.Range(drawInCell).Left
    For colCounter = 1 To basicColumnCount
'      ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
       curLeft, curTop, bDrawLongSide, bDrawShortSide).Select
      ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
       curLeft, curTop, bDrawShortSide, bDrawLongSide).Select
      ColorABox ' box must be selected!
      curLeft = curLeft + bDrawShortSide
    Next ' colCounter loop
    curTop = curTop + bDrawLongSide
    'now tackle the odd row if it is needed
    If oddRowCount > 0 Then
      curLeft = drawingWS.Range(drawInCell).Left
      For colCounter = 1 To oddColumnCount
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
         curLeft, curTop, bDrawLongSide, bDrawShortSide).Select
        ColorABox
        curLeft = curLeft + bDrawLongSide
      Next
    End If
  Next ' rowCounter loop
  Range(drawInCell).Select ' to unselect the last box drawn

FinalExitAndCleanup:
  'back to the sheet we started on
  currentWS.Activate
  'and release assigned resources
  Set currentWS = Nothing
  Set drawingWS = Nothing
  Set dataWS = Nothing
 
 
End Sub

Private Function GetTotalBoxCount(palletWidth As Long, palletHeight As Long, _
 boxHeight As Long, boxWidth As Long)
  'simply add box long axis together until the
  'total exceeds long axis of pallet then subtract 1
  Dim boxesPerBasicRow As Long
 
  Dim totalHeight As Double
  Dim totalWidth As Double
  Dim TotalBoxesInBasicRows As Long
  Dim TotalBoxesInOddRow As Long
 
  basicRowCount = Int(palletHeight / boxHeight)
  totalHeight = basicRowCount * boxHeight
  If totalHeight > palletHeight Then
    basicRowCount = basicRowCount - 1
    totalHeight = totalHeight - boxHeight
  End If
  oddRowCount = 0
  If palletHeight - totalHeight > boxWidth Then
    oddRowCount = 1
  End If
'now given the above info, how many boxes across for each row
  basicColumnCount = Int(palletWidth / boxWidth)
  totalWidth = basicColumnCount * boxWidth
  If totalWidth > palletWidth Then
    basicColumnCount = basicColumnCount - 1
  End If
  oddColumnCount = 0
  If oddRowCount > 0 Then
    oddColumnCount = Int(palletWidth / boxHeight)
    totalWidth = oddColumnCount * boxHeight
    If totalWidth > palletWidth Then
      oddColumnCount = oddColumnCount - 1
    End If
  End If
  TotalBoxesInBasicRows = basicRowCount * basicColumnCount
  TotalBoxesInOddRow = oddRowCount * oddColumnCount
  TotalBoxesOnPallet = TotalBoxesInBasicRows + TotalBoxesInOddRow
  GetTotalBoxCount = TotalBoxesOnPallet
End Function

Private Sub ColorABox()
  'the 'Box' must be selected when this is called
  'change the colors to pink/burgandy
  'may not work in versions of Excel before 2010
  'if it causes errors, just delete all of this within ***
  '*******************************
  With Selection.ShapeRange.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorAccent2
    .ForeColor.TintAndShade = 0
'    .ForeColor.Brightness = 0.6000000238 ' will error in Excel 2007
    .Transparency = 0
    .Solid
  End With
  With Selection.ShapeRange.Line
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorText1
    .ForeColor.TintAndShade = 0
'    .ForeColor.Brightness = -0.25 ' will error in Excel 2007
    .Transparency = 0
  End With
  '*******************************
End Sub
Angehängte Dateien
Dateityp: xlsm Palettenoptimierung.xlsm (30,0 KB, 26x aufgerufen)
StevEiserman ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 11.09.2016, 09:59   #2
xlph
MOF Meister
MOF Meister
Standard

In A8:A9 steht ja, dass möglicherweise durch manuelle Änderung weitere Boxen
passen!
xlph ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 11.09.2016, 10:28   #3
StevEiserman
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Weinen

Ja das stimmt aber oft, funktioniert die Aufteilung nur manchmal
halt nicht, das muss doch Lösbar sein, oder????
StevEiserman ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 11.09.2016, 11:12   #4
Storax
MOF Koryphäe
MOF Koryphäe
Standard

http://office-loesung.de/p/viewtopic.php?f=166&t=723386
IMHO ist das ein Optimierungsproblem und nicht trivial, aber es gibt sicher heuristische Lösungern
http://www.paletten-reichert.de/wiss...sport-rechner/
http://cargoload.de/
Storax ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2016, 00:05   #5
Oge
MOF Profi
MOF Profi
Standard

Hallo Stev,

in dem Programm war ein Fehler.

Der Programmierer hat zwar erkannt, dass man zwei Hauptrichtungen untersuchen muss, aber dadurch, dass er die Kartons und nicht die Palette bei der Eingabe der Funktion "gedreht" hat, hat das Programm nur erkannt, dass zusätzliche Kartons quer zur Hauptrichtung passen, wenn die Länge der Kartons in Richtung der Länge der Palette zeigten.

Ich habe noch zwei zusätzliche Änderungen eingebaut:
Wenn quer zur Hauptrichtung eine Reihe genau passt oder mehrere Reihen passen habe ich sie auch berücksichtigt. (Vorher war nur eine Reihe möglich, wenn der Platz ein wenig grösser war. (Kann ich natürlich rückgängig machen wenn nicht gewünscht.)

Durch diese Änderung war auch eine anpassung des Zeichenteils notwendig.

@ Storax
Da es sich sowohl bei der Palette als auch bei den gleichartigen Boxen um einfache Rechtecke handelt, kann mans auch berechnen.

Geändert von Oge (12.09.2016 um 00:12 Uhr).
Oge ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2016, 00:06   #6
Oge
MOF Profi
MOF Profi
Standard

Ich versuchs noch einmal mit der Datei:
Angehängte Dateien
Dateityp: xlsm Palettenoptimierung.xlsm (30,9 KB, 36x aufgerufen)
Oge ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2016, 07:33   #7
StevEiserman
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Beeindruckt Problem gelöst :)

Hallo Oge,

vielen Dank für Deine Mühe und die brillante Lösung!!!
Es war doch gut die Hoffnung nicht aufzugeben,
Sehr schön das es solche Leute wie Dich gibt, die andern
mit Ihrem Wissen Helfen und nicht nur dumme Sprüche ablassen,
Klasse ich bin Dir zu tausendmal Dankbar
So muss ein Forum sein, einfach nur topp!!!!

Gruß
StevEiserman
StevEiserman ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2016, 07:44   #8
StevEiserman
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Weinen doch noch nicht ganz gelöst

Hallo Oge,

es gibt noch ein Problem ich habe jetzt einen Karton eingegeben
(55x20)(B1;B2) hier beachtet jetzt das Programm nicht mehr die 120cm (B4)
von der Palette sondern ordnet darüber hinaus, könntest du noch mal drüber schauen?????


Gruß
Stev
StevEiserman ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2016, 10:08   #9
Oge
MOF Profi
MOF Profi
Standard

Hallo Stev,

in meiner Metrik ist 20 eindeutig kürzer(short side) als 55 (long side).
Also 20*55 statt 55*20.
Oge ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2016, 10:31   #10
StevEiserman
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Ups Wer lesen kann, kann lösen!!!

Hallo Oge,

okay Du hast recht, bei der alten Version war die Wahl (short side/long side) der Eingabe egal muss ich mich erst dran gewöhnen!!!!

Sorry, Danke noch mal!!!!!

Gruß
Stev
StevEiserman ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2016, 10:42   #11
Oge
MOF Profi
MOF Profi
Standard

Hallo Stev,

hier eine Version, die auch für deine Metrik richtig anzeigt.

Zwei Bemerkungen:
1) Im Feld Single Box Area stehen Konstanten in der Formel.
2) Gibt es eine bevorzugte Richtung der Boxen, wenn in beiden möglichen Fällen der gleiche Wert ermittelt wird? (Drehe in deinem Beispiel einmal die Palette.)
Angehängte Dateien
Dateityp: xlsm Palettenoptimierung.xlsm (30,4 KB, 22x aufgerufen)
Oge ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2016, 11:12   #12
StevEiserman
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo Oge,

Vielen Dank für Deine schnelle Anpassung, jetzt kann ja nichts mehr schiefgehen !!!!

Du hast recht mit der Single Box Area, warum da Konstanten drinstehen
weis ich leider auch nicht, ist bestimmt nicht so gewollt!!!

Zu 2.) Im Moment eigentlich nicht aber wenn die Möglichkeit besteht
dies Anzeigen zu lassen, wäre es nicht schlecht um vielleicht beim
stapeln für eine bessere Stabilität bzw. einen Verbund zu bilden.

Vorausgesetzt dies ist nicht so Aufwendig zu bewerkstelligen, denn
ich bin Dir für Deine jetzigen Anpassungen schon mehr als Dankbar!!!!

Gruß
Stev
StevEiserman ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2016, 13:50   #13
Oge
MOF Profi
MOF Profi
Standard

Hallo,

hab das Feld der Anzahl einmal grün hinterlegt, wenn beide Richtungen die gleiche Anzahl ergeben.
Zur Anzeige der zweiten Zusammenstellung kannst du dann die Palette drehen.

Auch wenns nicht notwendig ist können jetzt die Grössen der Boxen und der Palette mit Nachkommastellen eingetragen werden.
Angehängte Dateien
Dateityp: xlsm Palettenoptimierung.xlsm (31,6 KB, 54x aufgerufen)
Oge ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 12.09.2016, 14:01   #14
StevEiserman
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo Oge,

prima besser wie erst gedacht!!!!

Vielen Dank für Deine Mühe
Stev
StevEiserman ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 13.09.2016, 11:11   #15
xlph
MOF Meister
MOF Meister
Standard

Größen sollten immer in mm angegeben und gerechnet werden.

Damit entfallen Kommazahlen.
xlph ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 14:57 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.