|
Hallo miteinander,
ich bin sehr, sehr neu in der Welt von VBA und benötige wirklich Hilfe. Ich habe bisher leider nie mit Programmierung zu tun gehabt, soll jetzt aber für die Arbeit ein Excelmakro schreiben, das in einer gegebenen Exceltabelle (Portfolio dynamisch+PK) folgende Schritte nacheinander und idealerweise auf einen einzelnen Knopfdruck durchführt:
1. Nach Projektleiter A-Z sortieren (Spalte C)
2. Nach Projektphase nach benutzerdefinierter Reihenfolge sortieren (Spalte I; die Phasen sind in der Reihenfolge Finalisation, Realisation, Detailed-Concept, Basic-Concept, Initialisation, not started)
3. Immer, wenn der untere Projektleiter sich vom oberen unterscheidet (ich habe es hier mit dem Vergleich zweier Zeilen versucht), eine Leerzeile einfügen zwischen den Zeilen
3. Im Bereich Z-CU die erste Formel und das Format runterkopieren, die er findet (z.B. könnte die erste Zeile leer sein, in der zweiten "=A5 stehen)
4. Die neu eingefügten Zeilen grau Färben
Als Bereich habe ich aktuell die Spalten A-CU und die Zeilen 11-110
Mein aktueller Entwurf, der auch ursprünglich funktioniert hat, aber leider jetzt bei .Apply hängen bleibt, sieht so aus:
Sub Sortierung()
'
' Sortierung Makro
'
Range("A11:CU110").Select
Application.DeleteCustomList ListNum:=10
Application.AddCustomList ListArray:=Array("Finalisation", "Realisation", _
"Detailed-Concept", "Basic-Concept", "Initialisation", "Not started")
Application.DeleteCustomList ListNum:=9
ActiveWorkbook.Worksheets("Portfolio-dynamisch+PK").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Portfolio-dynamisch+PK").Sort.SortFields.Add Key:=Range("C11:C106") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Portfolio-dynamisch+PK").Sort.SortFields.Add Key:=Range("I11:I106") _
, SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Finalisation,Realisation,Detailed-Concept,Basic-Concept,Initialisation,Not started" _
, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Portfolio-dynamisch+PK").Sort
.SetRange Range("A11:CU110")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Dim lngRow As Long
Application.ScreenUpdating = False
For lngRow = Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
If Cells(lngRow, 3).Value <> Cells(lngRow - 1, 3).Value And _
Not IsEmpty(Cells(lngRow, 3)) And Not IsEmpty(Cells(lngRow - 1, 3)) Then _
Rows(lngRow).Insert shift:=xlShiftDown
Selection.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 2
Next
Application.ScreenUpdating = True
End With
End Sub
Bitte seht mir die vermutlich vielen Fehler nach, ich habe leider nie etwas über VBA gelernt und jetzt innerhalb kurzer Zeit zusammengefügt, was ich finden konnte. |