AW: Sortierfunktion
16.04.2012 15:20:20
werner
Hallo Reinhard,
sorry - bin davon ausgegangen, dass es leichter zu verstehen ist, wenn die Datei zur Verfügung steht.
Fehler werden nicht angezeigt.
Die Hintergrundfarbe der Felder der Spalte B kann durch eingeben von +, - oder o (kleines O) verändert werden. Die Sortierfunktion sortiert die Zeilen nach Farbe und innerhalb der Farben nach Datum in den Feldern der Spalte C.
Die Sortierung erfolgte bis vor ein paar Wochen einwandfrei.
Die Zeilen mit den roten Feldern (+) der Spalte B wurden unten angeordnet, die Zeilen mit den gelben Feldern (o) über den roten Zeilen, und die Zeilen mit den grünen Feldern über den gelben.
Alle Zeilen mit Daten ohne farbig gekennzeichnetes Feld in der Spalte B wurden über den Zeilen mit den grünen Feldern angeordnet.
Ich hoffen, dass die Beschreibung verständlich genug ist.
Gruß
Werner
Option Explicit
Sub Datum()
Dim Z
For Each Z In Selection
If Z "" Then
Z.Value = DateValue(Application.Substitute(Z, "/", "."))
Z.NumberFormat = "mm.dd.yyyy"
End If
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iCalc As Integer
If Not (Intersect(Range("g:g"), Target) Is Nothing) Then Target.Offset(0, -4) = Now()
If Not Intersect(Range("B2:B" & Rows.Count), Target) Is Nothing Then
With Application
iCalc = .Calculation
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
With ActiveSheet
.Protect Password:="Dein Kennwort", UserInterfaceOnly:=False
With .UsedRange
With .Columns(.Columns.Count).Offset(0, 1)
.FormulaR1C1 = "=IF(ROW()>3,IF(RC2=""+"",1,IF(RC2=""-"",3,IF(EXACT(RC2," _
"o""),2,""""))),-1)"
End With
End With
With .UsedRange
.Sort Key1:=.Cells(2, .Columns.Count), Order1:=xlAscending, _
key2:=.Cells(2, 3), Order2:=xlAscending, _
Header:=xlYes
.Columns(.Columns.Count).EntireColumn.Delete
End With
End With
.Calculation = iCalc
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub