PDA

Vollständige Version anzeigen : Update Zellenwert durch Formel


fonds
12.03.2009, 09:14
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....

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!

jinx
12.03.2009, 16:52
Moin, fonds,

das Change-.Ereignis setzt eine direkte Eingabe in den Bereich voraus - was Du suchst, sollte über das Calculate-Ereignis oder die Kontrolle der dort verlinkten Zellen zu erreichen sein.