Priorisierung mit leeren Zeilen
Stefan
habe einen Code bekommen, der mir ne Priorisierung meiner offenen Arbeiten erlaubt.
Funktioniert super
Problem: Habe in meinen offenen Arbeiten ab und an leere Zeilen (die ich nicht einfach löschen kann)
wenn leere Zeile dazwischen sind, dann funktionierts plötzlich nicht mehr richtig...
Kann mir jemand sagen wo das Problem liegt und wie man es lösen kann ?
Hier der Code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lPrioritaet As Long, lLastRow As Long, Zeile As Long, vdate
If Target.Row >= 100 And Target.Cells.Count = 1 Then
lLastRow = Me.Cells(Me.Rows.Count, 1).End(xlUp).Row
Application.EnableEvents = False
Select Case Target.Column
Case 1 'Priorität wurde eingegeben
If Not IsNumeric(Target) Or Target.Value 0 eingegeben werden", _
vbInformation + vbOKOnly, "Neue Priorität"
Else
If MsgBox("Priorität neu einsortieren?", vbQuestion + vbYesNo, _
"Neue Priorität") = vbYes Then
lPrioritaet = Target.Value
'Prüfen, ob Priorität schon vorhanden
If Application.WorksheetFunction.CountIf(Range(Cells(100, 1), _
Cells(lLastRow, 1)), lPrioritaet) > 1 Then
'vorhandenen Prioritäten >= Priorität um 1 erhöhen
For Zeile = 100 To lLastRow
If Cells(Zeile, 1) >= lPrioritaet And Zeile Target.Row Then
Cells(Zeile, 1) = Cells(Zeile, 1) + 1
End If
Next
End If
'Daten nach Priorität und Datum sortieren
With Range(Cells(100, 1), Cells(lLastRow, 5))
.Sort key1:=.Range("A1"), order1:=xlAscending, _
key2:=.Range("E1"), order2:=xlAscending, Header:=xlNo
End With
'Zeile mit geänderter Priorität selektieren
With Range(Cells(100, 1), Cells(lLastRow, 1))
.Find(what:=lPrioritaet, LookIn:=xlValues, _
lookat:=xlWhole).Offset(0, 1).Select
End With
End If
End If
Case 5 'Erledigt Datum wurde eingetragen/gelöscht
If Cells(Target.Row, 1) = 0 Then
MsgBox "Bei einem erledigten Eintrag darf das Datum nicht geändert werden!"
ElseIf IsEmpty(Target) Then
MsgBox "Erledigt-Datum wurde gelöscht, Priorität wird nicht geändert."
Else
If MsgBox("Priorität der erledigten Aktivität auf 0 setzen?", _
vbQuestion + vbYesNo, "Priorität erledigt") = vbYes Then
vdate = Target.Value 'Erledigt-Datum merken
lPrioritaet = Cells(Target.Row, 1) 'Priorität merken
Cells(Target.Row, 1) = 0 'Priorität auf 0 setzen
'Prioritäten größer als erledigte Priorität um 1 reduzieren
For Zeile = 100 To lLastRow
If Cells(Zeile, 1) > lPrioritaet And Zeile Target.Row Then
Cells(Zeile, 1) = Cells(Zeile, 1) - 1
End If
Next
'Daten sortieren
With Range(Cells(100, 1), Cells(lLastRow, 5))
.Sort key1:=.Range("A1"), order1:=xlAscending, _
key2:=.Range("E1"), order2:=xlAscending, Header:=xlNo
End With
'Zeile mit Erledigt-Datum selektieren
With Range(Cells(100, 5), Cells(lLastRow, 5))
.Find(what:=vdate, After:=Cells(lLastRow, 5), LookIn:=xlValues, _
lookat:=xlWhole, Searchdirection:=xlPrevious).Select
End With
End If
End If
End Select
Application.EnableEvents = True
End If
End Sub