Private Sub Worksheet_Change(ByVal Target As Range)

[fonds]

Hallo,

ich möchte mit folgendem Code die Länder einer Karte in verschiedenen Farben darstellen.
Bis jetzt hatte ich die Zahlen 1-10 und es hat wunderbar funktioniert.
Nun habe ich die Zahlen Werte geändert > 0.4 etc. da ich in der Spalte in Excel nicht mehr ganze Zahlen erhalte.

Leider funktioniert der Code nicht mehr...
Was kann ich hier ändern....




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 > -0.35 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(255, 0, 0)
ElseIf Target > -0.25 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(255, 66, 66)
ElseIf Target > -0.15 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(255, 125, 125)
ElseIf Target > -0.05 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(255, 200, 200)
ElseIf Target > 0.05 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(230, 230, 230)
ElseIf Target > 0.15 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(200, 255, 200)
ElseIf Target > 0.25 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(150, 200, 150)
ElseIf Target > 0.35 Then ActiveSheet.Shapes(strName).Fill.ForeColor.RGB = RGB(75, 150, 75)
Else
If Target > 0.4 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

 

[Drogist]

Hallo,

ich mag jetzt nicht den ganzen Code analysieren, aber

Private Sub Worksheet_Change(ByVal Target As Range)

das könnte die Macke sein. Range ist ja prinzipiell eine Zell-Adresse und die kann in keinem Fall unter 1 sein. mach ein As Variant daraus und versuche es noch einmal, vielleicht klappt es dann.

Ach ja, Select Case ist eine wirklich feine Sache ...