PDA

Vollständige Version anzeigen : Private Sub Worksheet_Change(ByVal Target As Range)


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

jinx
12.03.2009, 16:36
Moin, fonds,

zumindest ich kann aus Deinem Code und den nicht vorhandenen Beispielwerten keine Farbzuweisungen hervorzaubern - es kann z.B. die Eingabe direkt durch 10 geteilt werden, in den Optionen eine Stelle herausgenommen werden Vorsicht bei der Übergabe dieser Mappe dann an andere User, die sich sicherlich wundern, warum 10 nur als 1 dargestellt wird.