Die Daten in der Datei befinden sich im Reiter "WorkBench" und sind bereits 1x sortiert. Der Plan war die Aufträge hintereinander nach verschiedenen Kriterien sortieren zu lassen um eine optimale Reihenfolge zu bekommen. Das erste Kriterium ist der Termin, dazu werden Die Termine in Blöcken von z.B. 3 Wochen zusammengefasst. In diesen Blöcken soll dann nach 4 weiteren Kriterien sortiert werden. Die Kriterien sind von links nach rechts absteigend nach Wichtigkeit geordnet.
1. Schritt: SortFirmItemsOut
Hier werden fixierte Aufträge nach vorn sortiert. Sind späten vom umsortieren ausgeschlossen.
--> Sortierung nur über Maschine, keine Anpassung der Reihenfolge...
--> bis jetzt kein Problem
Sub SortFirmItemsOut(LastRow1, strBereich, strSpalte1, strSpalte18, strSpalte20)
'Sortierung Makro
'Makro sortiert die aufgelisteten Fertigungsaufträge so, dass die fixierten aufträge am Anfang _
stehen bleiben.
'Bestand in Bearbeitung und Durchlaufzeiten sind nicht berücksichtigt.
' Define Constants
' strSpalte1 = Machine
' strSpalte18 = Due Date
' strSpalte20 = Firm Status
'Sort SAB's - Sortierung kann nur 3 KEY's aufnehmen, daher Sortierung von "innen nach außen" _
, d.h. die Hauptattribute kommen am Ende
With Tabelle1.Range(strBereich1)
'Sort Lvl 1
.Sort _
Key1:=Range(strSpalte20 & strZeile1), Order1:=xlAscending, _
Key2:=Range(strSpalte1 & strZeile1), Order2:=xlAscending, _
Key3:=Range(strSpalte18 & strZeile1), Order3:=xlAscending, Header:=xlYes, _
DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers, DataOption3:=xlSortTextAsNumbers
End With
FirstRowAfterFirm = Evaluate("=LOOKUP(2,1/(E1:E65535=""firm""),ROW(E:E))") + 1
End Sub
2. Schritt: SortMinimizeSetUp
Ich verwende einen Excelfilter und lasse die Daten jeweils aufsteigend sortieren.
das oberste Kriterium sind Zeitblöcke (Termine der Aufträge in einen 3 Wocheblock einsortiert).
Die Aufträge sind nun nach den Blöcken sortiert und innerhalb der Blöcke wird nach weiteren Kriterien sortiert.
--> Das hat funktioniert!
sieht bei mir so aus:
Sub SortMinimizeSetUp(LastRow1, strBereich, strSpalte1, strSpalte2, strSpalte3, strSpalte4, _
strSpalte5, strSpalte6, strSpalte7, strSpalte8, strSpalte9, strSpalte10, strSpalte11, strSpalte12, strSpalte13, strSpalte14, strSpalte15, strSpalte16, strSpalte17, strSpalte18)
'Sortierung Makro
'Makro sortiert die aufgelisteten Fertigungsaufträge so, dass die Rüstzeiten minimiert werden.
'Bestand in Bearbeitung und Durchlaufzeiten sind nicht berücksichtigt.
'strSpalte18 = Due Date
'Sort SAB's - Sortierung kann nur 3 KEY's aufnehmen, daher Sortierung von "innen nach außen" _
, d.h. die Hauptattribute kommen am Ende
With Tabelle1.Range(strBereich)
'Sort Lvl 6
.Sort _
Key1:=Range(strSpalte16 & strZeile1), Order1:=xlAscending, _
Key2:=Range(strSpalte17 & strZeile1), Order2:=xlAscending, _
Key3:=Range(strSpalte18 & strZeile1), Order3:=xlAscending, Header:=xlYes, _
DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers, DataOption3:=xlSortTextAsNumbers
'Sort Lvl 5
.Sort _
Key1:=Range(strSpalte13 & strZeile1), Order1:=xlAscending, _
Key2:=Range(strSpalte14 & strZeile1), Order2:=xlAscending, _
Key3:=Range(strSpalte15 & strZeile1), Order3:=xlAscending, Header:=xlYes, _
DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers, DataOption3:=xlSortTextAsNumbers
'Sort Lvl 4
.Sort _
Key1:=Range(strSpalte10 & strZeile1), Order1:=xlAscending, _
Key2:=Range(strSpalte11 & strZeile1), Order2:=xlAscending, _
Key3:=Range(strSpalte12 & strZeile1), Order3:=xlAscending, Header:=xlYes, _
DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers, DataOption3:=xlSortTextAsNumbers
'Sort Lvl 3
.Sort _
Key1:=Range(strSpalte7 & strZeile1), Order1:=xlAscending, _
Key2:=Range(strSpalte8 & strZeile1), Order2:=xlAscending, _
Key3:=Range(strSpalte9 & strZeile1), Order3:=xlAscending, Header:=xlYes, _
DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers, DataOption3:=xlSortTextAsNumbers
'Sort Lvl 2
.Sort _
Key1:=Range(strSpalte4 & strZeile1), Order1:=xlAscending, _
Key2:=Range(strSpalte5 & strZeile1), Order2:=xlAscending, _
Key3:=Range(strSpalte6 & strZeile1), Order3:=xlAscending, Header:=xlYes, _
DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers, DataOption3:=xlSortTextAsNumbers
'Sort Lvl 1
.Sort _
Key1:=Range(strSpalte1 & strZeile1), Order1:=xlAscending, _
Key2:=Range(strSpalte2 & strZeile1), Order2:=xlAscending, _
Key3:=Range(strSpalte3 & strZeile1), Order3:=xlAscending, Header:=xlYes, _
DataOption1:=xlSortNormal, DataOption2:=xlSortTextAsNumbers, DataOption3:=xlSortTextAsNumbers
End With
End Sub
3. Schritt: SortCrossing
Die Übergänge der Blöcke sind nun aufgrund der Sortierreihenfolge (Aufsteigend) nicht optimal. EXCEL sortiert z.B.:
- Block 1 = A / A / B / C / C / C,
- Block 2 = A / A / C / C / D / D / D,...
Hier wäre es schön, der 2. Block würde dann mit C beginnen, also dem Wert, mit dem der 1. Block endet. Danach kann EXCEL wieder aufsteigend sortieren.
Mir fehlt hier ein Ansatz das in EXCEL mit einem Makro umzusetzen.
Die Idee war innerhalb der Blöcke nochmals zu sortieren aber diesmal mit dem wichtigsten Attribut1 als oberster Filter. Der Bereich sollte laufen vom letzten Eintrag des vorangegangenen Blocks bis zum letzten Eintrag des aktuellen Blocks. Ziel ist die oben beschriebene Ausrichtung zu bekommen.
Momentan habe ich das Sortier-Makro so umgesetzt:
Option Explicit
Dim strBereich As String 'Area of the scheduling workbench after _
the firmed orders
Dim strBereich1 As String 'Total area of the scheduling workbench
Dim LastRow1 As Integer 'Letze Zeile - Tabelle 1
Dim LastRowFirm As Integer 'Letze Zeile - Tabelle 1 Firm
Dim FirstRowAfterFirm As Integer 'Erste Zeile nach Fixierten Aufträgen - _
Tabelle 1
Dim strZeile1 As String 'Row where the data in the workbench _
starts (incl. headers)
Dim strSpalte1, strSpalte2, strSpalte3 As String 'Columns with Attributes - Lvl 1
Dim strSpalte4, strSpalte5, strSpalte6 As String 'Columns with Attributes - Lvl 2
Dim strSpalte7, strSpalte8, strSpalte9 As String 'Columns with Attributes - Lvl 3
Dim strSpalte10, strSpalte11, strSpalte12 As String 'Columns with Attributes - Lvl 4
Dim strSpalte13, strSpalte14, strSpalte15 As String 'Columns with Attributes - Lvl 5
Dim strSpalte16, strSpalte17, strSpalte18 As String 'Columns with Attributes - Lvl 6
Dim strSpalte19, strSpalte20 As String 'Columns with Attributes - Lvl 7
Sub LineUp()
'Makro baut einen Lineup nach gegebener Regel auf
Application.ScreenUpdating = False
'Define Constants
strZeile1 = Tabelle3.Cells(9, 4) '1st Line Workbench
strSpalte1 = Tabelle3.Cells(39, 6) 'Machine
strSpalte2 = Tabelle3.Cells(43, 6) 'Setup Grp
strSpalte3 = Tabelle3.Cells(49, 6) 'SAB-01
'strSpalte19 = Tabelle3.Cells(47, 6) 'Material available
strSpalte20 = Tabelle3.Cells(45, 6) 'Firm Status
strSpalte4 = Tabelle3.Cells(51, 6) 'SAB-02
strSpalte5 = Tabelle3.Cells(53, 6) 'SAB-03
strSpalte6 = Tabelle3.Cells(55, 6) 'SAB-04
strSpalte7 = Tabelle3.Cells(57, 6) 'SAB-05
strSpalte8 = Tabelle3.Cells(59, 6) 'SAB-06
strSpalte9 = Tabelle3.Cells(61, 6) 'SAB-07
strSpalte10 = Tabelle3.Cells(63, 6) 'SAB-08
strSpalte11 = Tabelle3.Cells(65, 6) 'SAB-09
strSpalte12 = Tabelle3.Cells(67, 6) 'SAB-10
strSpalte13 = Tabelle3.Cells(69, 6) 'SAB-11
strSpalte14 = Tabelle3.Cells(71, 6) 'SAB-12
strSpalte15 = Tabelle3.Cells(73, 6) 'SAB-13
strSpalte16 = Tabelle3.Cells(75, 6) 'SAB-14
strSpalte17 = Tabelle3.Cells(77, 6) 'SAB-15
strSpalte18 = Tabelle3.Cells(41, 6) 'Due Date
'go to Workbench-Sheet
Tabelle1.Activate
'Build LineUp
LastRow1 = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row 'last _
filled Row of Sheet1
strBereich1 = Tabelle3.Cells(5, 4) & "2:" & Tabelle3.Cells(7, 4) & LastRow1 'Total _
area of the scheduling workbench, for example. strBereich = "A2:W10"
Call SortFirmItemsOut(LastRow1, strBereich, strSpalte1, strSpalte18, strSpalte20)
strBereich = Tabelle3.Cells(5, 4) & FirstRowAfterFirm & ":" & Tabelle3.Cells(7, 4) & _
LastRow1 'Area of the scheduling workbench after the firmed orders
Call SortMinimizeSetUp(LastRow1, strBereich, strSpalte1, strSpalte2, strSpalte3, _
strSpalte4, strSpalte5, strSpalte6, strSpalte7, strSpalte8, strSpalte9, strSpalte10, strSpalte11, strSpalte12, strSpalte13, strSpalte14, strSpalte15, strSpalte16, strSpalte17, strSpalte18)
' --> Einsortieren der Firms noch einfügen
Call SortCrossing(FirstRowAfterFirm, strBereich1)
Application.ScreenUpdating = True
'ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear 'delete sort key from sort _
fields
MsgBox "LineUp build finished!" & vbCrLf & vbCrLf & "SortFirmItemsOut - done" & vbCrLf & " _
SortMinimizeSetUp - done"
End Sub
Mir fehlt noch das "Richten" der Übergänge sowie später dann das Einsortieren der fixierten Aufträge...
Eigentlich brauche ich eine Idee, wie ich die Bereiche (Zeitblöcke) zum Sortieren auswählen kann. Im Prinzip wäre das eigentlich "nur" eine Schleife über alle Blöcke und darin sortiere nach Zeitblock, Attribut1 und Attribut2. Ich krieg die Blöcke nicht zu greifen, weil die ja dynamisch sind (unterschiedliche Größe, unterschiedliche Start-/Endeposition innerhalb der Spalten). Vielleicht selektierbar über die Kombination der Spalten "Machine" und "Setup Grp" (Für alle Elemente in "Setup Grp" auf Machine-A --> sortiere...) ?
Gruß
Gugelhupf