# Private Sub Worksheet_Change(ByVal Target As Range)



## fonds (12. März 2009)

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 (12. März 2009)

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 ...


----------

