Produktionsplan in Excel VBA

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hab mal was zusammengeschustert.
Problem aktuell dürfte noch sein das die Ausnutzung der Maschinen noch nicht optimiert wurde. (ist mir auch grad nix zu eingefallen ^^)
Da ich nicht genau wußte wie die Ausgabe aussehen soll, habe ich es erstmal ganz einfach gehalten.
Keine farblichen Markierungen und kein zusammenfassen.
Auf der 1. Seite sieht man die zusammengerechneten Zeiten
Die Zeiten für 1 Werkstück weicht aber ab, weil die Auswertung nur nach der Position geht.
Somit kann die Zeit bis zur "Fertigstellung" (deutlicher) höher sein als die reine Zeit wenn man die Minuten addiert.
Trotzdem ist die Zeit zur Fertigstellung aller Aufträge geringer als die der Summe der einzelnen Aufträge.
"Application.ScreenUpdating" ist da momentan nicht drin - also nicht wundern wenn man alles sieht und es dadurch etwas länger dauert.
Falls du das anders willst, musst du eine genauere Beschreibung liefern und am besten ein Beispielblatt wo vorne Zeiten stehen und bei Ergebnis das, was du haben willst.

Die Datei https://www.herber.de/bbs/user/91307.xlsm wurde aus Datenschutzgründen gelöscht

Hallo Jürgen,
gleiches Prinzip wie bei Franc, hier mit einem Gantt-Chart.
Die Ausnutzung ist nicht optimal, eine Möglichkeit wäre hier ein lineares Gleichungssystem zu erstellen und dieses mit dem Solver zu lösen.
@Franc: bei deinem Code ist noch ein Fehler drin - zB. bei Auftrag 10, da wird Maschine 4 von Maschine 5 überschrieben.

Option Explicit
Sub TestIt()
Dim i As Long, j As Long, k As Long
Dim lngOrd As Long, lngMch As Long
Dim lngDur As Long, lngPos As Long
Dim lngMchPos() As Long, lngOrdPos() As Long
Dim lngWork() As Long, lngClr() As Long
Dim ch As Chart
Const ORDERS As Long = 10
Const MACHINES As Long = 5
ReDim lngWork(1 To ORDERS, 1 To MACHINES, 1 To 2)
ReDim lngMchPos(1 To MACHINES)
ReDim lngOrdPos(1 To ORDERS)
ReDim lngClr(1 To MACHINES)
lngClr(1) = RGB(255, 0, 0)      ' red
lngClr(2) = RGB(0, 255, 0)      ' green
lngClr(3) = RGB(0, 0, 255)      ' blue
lngClr(4) = RGB(255, 192, 0)    ' orange
lngClr(5) = RGB(255, 0, 255)    ' magenta
With Sheets("User-Eingaben")
For j = 1 To MACHINES
For i = 1 To ORDERS
If .Cells(i + 16, j + 2) > 0 Then
lngMch = .Cells(i + 16, j + 2)
If .Cells(i + 2, lngMch + 2) > 0 Then
lngOrd = i
lngDur = .Cells(i + 2, lngMch + 2)
lngPos = Application.Max(lngOrdPos(lngOrd), lngMchPos(lngMch))
lngWork(lngOrd, lngMch, 1) = lngPos
lngWork(lngOrd, lngMch, 2) = lngDur
lngOrdPos(lngOrd) = lngPos + lngDur
lngMchPos(lngMch) = lngPos + lngDur
End If
End If
Next
Next
End With
With Sheets("Ergebnisse")
.Cells.Delete
.Cells(1, 1).Resize(, 3) = Array("Auftrag-Maschine", "Start", "Dauer")
k = 2
For i = 1 To ORDERS
For j = 1 To MACHINES
.Cells(k, 1) = "Auftr-" & i & "_Masch-" & j
.Cells(k, 2) = lngWork(i, j, 1)
.Cells(k, 3) = lngWork(i, j, 2)
k = k + 1
Next
Next
.Columns(1).Resize(, 3).AutoFit
Set ch = .Shapes.AddChart.Chart
ch.ChartType = xlBarStacked
ch.SetSourceData Source:=.Cells(2, 1).Resize(k - 2, 3)
ch.SeriesCollection(1).Format.Fill.Visible = msoFalse
ch.ChartArea.Left = .Cells(1, 5).Left
ch.ChartArea.Top = 0
ch.ChartArea.Height = ORDERS * MACHINES * 15
ch.ChartArea.Width = 600
ch.Axes(xlCategory).ReversePlotOrder = True
ch.Axes(xlCategory).TickMarkSpacing = MACHINES
ch.SetElement (msoElementPrimaryCategoryGridLinesMajor)
ch.HasLegend = False
For i = 1 To MACHINES * ORDERS Step MACHINES
For j = 1 To MACHINES
ch.SeriesCollection(2).Points(i + j - 1).Format.Fill.ForeColor.RGB = lngClr(j)
Next
Next
End With
Set ch = Nothing
End Sub

Gruß
ChristianM

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread