AW: priorisieren einer Spalte über VBA
19.07.2010 23:00:18
fcs
Hallo Stefan,
das folgende Ereignismakro soll die gewünschte Funktionalität haben.
Du musst es im VBA-Editor unter dem entsprechenden Tabellenblatt einfügen.
Gruß
Franz
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