AW: Absturz beim Speichern
14.09.2007 15:08:54
Rudi
Hallo,
hast du mal nen Haltepunkt gesetzt und bist das Makro von Hand durchgegangen?
Das ruft sich immer wieder selbst auf, da ja Zellen geändert werden.
Außerdem kann man es auf die Hälfte kürzen.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngUnion As Range, rngUBereich As Range
If Target.Count > 1 Then Exit Sub
Set rngUBereich = Worksheets("1Halbjahr").Range("E5:GK35")
Set rngUnion = Application.Union(Range(Target.Address), rngUBereich)
If rngUnion.Address rngUBereich.Address Then Exit Sub
On Error GoTo FEHLER
Application.EnableEvents = False
Select Case UCase(Target.Value)
Case "L"
Target = UCase(Target)
If Target.Interior.ColorIndex 4 Then
Target.Interior.ColorIndex = 46
Target.Font.FontStyle = "Standart"
Target.Font.ColorIndex = xlAutomatic
End If
Case "E"
Target = UCase(Target)
Target.Interior.ColorIndex = 15
Target.Font.FontStyle = "Standart"
Target.Font.ColorIndex = xlAutomatic
Case "U"
Target = UCase(Target)
Target.Font.FontStyle = "Standart"
Target.Font.ColorIndex = xlAutomatic
Case "UU"
Target = UCase(Target)
If Target.Interior.ColorIndex 36 And Target.Interior.ColorIndex 4 Then
Target.Interior.ColorIndex = 45
Target.Font.FontStyle = "Standart"
Target.Font.ColorIndex = xlAutomatic
End If
Case "K"
Target = UCase(Target)
Target.Interior.ColorIndex = 3
Target.Font.FontStyle = "Standart"
Target.Font.ColorIndex = xlAutomatic
Case "KK"
Target = "K"
Target.Interior.ColorIndex = 44
Target.Font.FontStyle = "Standart"
Target.Font.ColorIndex = xlAutomatic
Case "D"
Target.Value = "D"
If Target.Interior.ColorIndex 4 Then
Target.Interior.ColorIndex = 6
Target.Font.FontStyle = "Standart"
Target.Font.ColorIndex = xlAutomatic
End If
Case "A"
Target.Value = "A"
Target.Interior.ColorIndex = 7
Target.Font.FontStyle = "Standart"
Target.Font.ColorIndex = xlAutomatic
Case "V"
Target = UCase(Target)
Target.Interior.ColorIndex = 17
Target.Font.FontStyle = "Standart"
Target.Font.ColorIndex = xlAutomatic
Case "F", "P", "S"
Target = UCase(Target)
If Target.Interior.ColorIndex 4 Then
Target.Interior.ColorIndex = 8
Target.Font.FontStyle = "Standart"
Target.Font.ColorIndex = xlAutomatic
End If
Case "FF", "SS", "NN", "TT"
Target = UCase(Left(Target, 1))
If Target.Interior.ColorIndex 36 And Target.Interior.ColorIndex 4 Then
Target.Interior.ColorIndex = xlNone
Target.Font.FontStyle = "Fett"
Target.Font.ColorIndex = 3
End If
Case "N", "T"
Target = UCase(Target)
If Target.Interior.ColorIndex 36 And Target.Interior.ColorIndex 4 Then
Target.Interior.ColorIndex = 8
Target.Font.FontStyle = "Standart"
Target.Font.ColorIndex = xlAutomatic
End If
End Select
FEHLER:
Application.EnableEvents = True
End Sub
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe