Update Zellenwert durch Formel Excel

fonds

Mitglied
Hallo!

Ich habe folgende Problem...zuerst hatte ich den Code nur dafür, Zahlenwerte von 1-10 in die Zellen (B9-B21) einzugeben und danach hat sich meine Karte automatisch gändert. Nun habe ich mein Sheet geändert und es kommen die Werte durch eine Formel z.B. für B9 (=WENN($C9<$A$25; "zu Niedrig"; SVERWEIS($C9; $A$25:$C$33; 3))) in die entsprechen Zellen.
Nur leider ändern sich nun nicht mehr automatisch meine Karte bzw. die Farben meiner Karte....

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strName As String
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("B9:B21")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    If Target.Address = "$B$9" Then
        strName = "Freeform 106"
    ElseIf Target.Address = "$B$10" Then strName = "Freeform 121"
    ElseIf Target.Address = "$B$11" Then strName = "Freeform 67"
    ElseIf Target.Address = "$B$12" Then strName = "Group 878"
    ElseIf Target.Address = "$B$13" Then strName = "Freeform 115"
    ElseIf Target.Address = "$B$14" Then strName = "Group 875"
    ElseIf Target.Address = "$B$15" Then strName = "Freeform 479"
    ElseIf Target.Address = "$B$16" Then strName = "Group 877"
    ElseIf Target.Address = "$B$17" Then strName = "Freeform 202"
    ElseIf Target.Address = "$B$18" Then strName = "Freeform 130"
    ElseIf Target.Address = "$B$19" Then strName = "Group 876"
    ElseIf Target.Address = "$B$20" Then strName = "Freeform 112"
    Else
        strName = "Group 879"
    End If
    If Target = 1 Then
        ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(255, 0, 0)
    ElseIf Target = 2 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(255, 66, 66)
    ElseIf Target = 3 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(255, 125, 125)
    ElseIf Target = 4 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(255, 200, 200)
    ElseIf Target = 5 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(230, 230, 230)
    ElseIf Target = 6 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(200, 255, 200)
    ElseIf Target = 7 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(150, 200, 150)
    ElseIf Target = 8 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(75, 150, 75)
    Else
        If Target = 9 Then
            ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(25, 100, 25)
        Else
            MsgBox "Bitte Werte zwischen 1 und 10 eingeben"
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
    End If

    Application.ScreenUpdating = True
End Sub

Was muss ich ändern damit meine Karte sich automatisch ändert?

Besten Dank im voraus!
 
Zurück