Zeilen Sortieren

Hallo Forum,
Ich benötige einmal-mehr eure Hilfe.
In einer Datei sollen Zeilen nach Farbgruppen sortiert werden, und innerhalb der Farbgruppen nach Datum in der Spalte D. Dieses erfolgt in dem in Spalte B pro Farbe ein Sonderzeichen in der jeweiligen Zelle eingegeben wird. Für Grün das Pluszeichen, für Gelb das Kommazeichen und für Rot das Minuszeichen.
Dieses funktioniert auch, jedoch nur wenn die Zeilen leer sind. Den Fehler kann ich nicht finden.
https://www.herber.de/bbs/user/96248.xlsm
Im April 2011 hatte ich schon einmal mit der Hilfe des Forums entsprechendes erstellt, was funktionierte. Nun habe ich diese Datei etwas modifiziert und schon funktioniert es nicht richtig.
Vielen Dank für eure Unterstützung.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

With ActiveSheet With .UsedRange With .Columns(.Columns.Count).Offset(0, 1) .FormulaR1C1 = "=IF(ROW()>1,IF(RC2=""-"",1,IF(RC2="","",2,IF(EXACT(RC2,""+""),3,"""" _ ))),-1)" End With End With With .UsedRange .Sort Key1:=.Cells(2, .Columns.Count), Order1:=xlAscending, _ Key2:=.Cells(2, 3), Order1:=xlAscending, _ Header:=xlYes .Columns(.Columns.Count).EntireColumn.Delete End With End With

Hallo Werner,
du hast nur eine ebene beim sortiern berücksichtigt, das ist der Fehler.
so geht es (allerdings noch fix bis Spalte R)


Private Sub Worksheet_Change(ByVal Target As Range)
Dim iCalc As Integer
Dim letztezeile As Long
Dim letzespalte As Integer
If Not Intersect(Range("B2:B" & Rows.Count), Target) Is Nothing Then
With Application
iCalc = .Calculation
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
With ActiveSheet
letztezeile = .Cells(Rows.Count, 2).End(xlUp).Row
With .UsedRange
With .Columns(.Columns.Count).Offset(0, 1)
'.FormulaR1C1 = "=IF(RC2=""-"",1,IF(RC2="","",2,IF(EXACT(RC2,""+""),3,"" _
"")))"
.FormulaR1C1 = "=IF(ROW()>3,IF(RC2=""-"",1,IF(RC2="","",2,IF(EXACT(RC2," _
"+""),3,""""))),-1)"
End With
End With
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("B2:B" & letztezeile), SortOn:=xlSortOnValues,  _
Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("D2:D" & letztezeile), SortOn:=xlSortOnValues,  _
Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("B1:R" & letztezeile)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
.Calculation = iCalc
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub

gruß
yummi

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread