Zellen vergleichen

Engin · 2008-06-12T10:56:09+00:00

Hallo zusammen, wie kann ich per Makro ermöglichen, dass in ein Punktdiagramm das aus Zellen Werte besteht, so machen kann, wenn von Zelle A2 bis A10 Werte sind die größer als Null sind dann die entsprechende Punkte im Diagramm andere Farbe darstellt.? Danke

Hi,
auf das konkrete Beispiel von meiner HP zugeschnitten:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim chDiagramm As Chart             ' Variable für das Diagramm als Objekt
Dim raZelle As Range
'   wenn Änderung nicht im definierten Bereich
If Intersect(Target, Range("B9:O9")) Is Nothing Then Exit Sub
'   Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'   Diagramm1 der Variablen zuweisen
Set chDiagramm = ActiveSheet.ChartObjects(1).Chart
With chDiagramm
If Target.Count > 1 Then
For Each raZelle In Selection
With .SeriesCollection(1).Points(raZelle.Column - 1)
If raZelle = 1 Or raZelle = 2 Then
'                       Hintergrundfarbe des Datenpunktes
.MarkerBackgroundColorIndex = 4
'                       Vordergrundfarbe des Datenpunktes
.MarkerForegroundColorIndex = 4
ElseIf raZelle = 3 Or raZelle = 4 Then
.MarkerBackgroundColorIndex = 6
.MarkerForegroundColorIndex = 6
Else
If raZelle  "" Then
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
End If
End If
End With
Next raZelle
Else
'           Datenpunktposition innerhalb der Reihe wird aus der Spalte - 1 ermittelt
With .SeriesCollection(1).Points(Target.Column - 1)
If Target = 1 Or Target = 2 Then
'                   Hintergrundfarbe des Datenpunktes
.MarkerBackgroundColorIndex = 4
'                   Vordergrundfarbe des Datenpunktes
.MarkerForegroundColorIndex = 4
ElseIf Target = 3 Or Target = 4 Then
.MarkerBackgroundColorIndex = 6
.MarkerForegroundColorIndex = 6
Else
If Target  "" Then
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
End If
End If
End With
End If
End With
'   Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End Sub

Hi,
weshalb sollte man eine Arbeitsmappe hochladen, wenn ein Helfer darum bittet?
1. Ein Code ist in den meisten Fällen ganz konkret auf spezielle Bedingungen in der Arbeitsmappe angepasst und lässt sich nicht "einfach so mal nebenbei" auf andere Bedingungen umschreiben. Wenn man einen Code postet, möchte man ihn schon unter möglichst originalen Bedingungen testen.
2. Du hast bereits Zeit in die Erstellung deiner Arbeitsmappe investiert, weshalb sollte sie also noch einmal erstellt werden indem sie nachgebaut wird? Außerdem ist ein Nachbau einer Arbeitsmappe nicht identisch mit dem Original, es kann also sein, dass nicht alle Bedingungen berücksichtigt werden können und der Code deshalb in deinem Original dann nicht funktioniert. Du schreibst, dass du kaum VBA-Kenntnisse hast, deshalb ist dies umso wichtiger.
Hier der Code, ungetestet:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim chDiagramm As Chart             ' Variable für das Diagramm als Objekt
Dim raZelle As Range
'   wenn Änderung nicht im definierten Bereich
If Intersect(Target, Range("B1:B10")) Is Nothing Then Exit Sub
'   Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'   Diagramm1 der Variablen zuweisen
Set chDiagramm = ActiveSheet.ChartObjects(1).Chart
With chDiagramm
If Target.Count > 1 Then
For Each raZelle In Selection
With .SeriesCollection(1).Points(raZelle.Row)
If raZelle = 1 Or raZelle = 2 Then
'                       Hintergrundfarbe des Datenpunktes
.MarkerBackgroundColorIndex = 4
'                       Vordergrundfarbe des Datenpunktes
.MarkerForegroundColorIndex = 4
ElseIf raZelle = 3 Or raZelle = 4 Then
.MarkerBackgroundColorIndex = 6
.MarkerForegroundColorIndex = 6
Else
If raZelle  "" Then
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
End If
End If
End With
Next raZelle
Else
'           Datenpunktposition innerhalb der Reihe wird aus der Zeile ermittelt
With .SeriesCollection(1).Points(Target.Row)
If Target = 1 Or Target = 2 Then
'                   Hintergrundfarbe des Datenpunktes
.MarkerBackgroundColorIndex = 4
'                   Vordergrundfarbe des Datenpunktes
.MarkerForegroundColorIndex = 4
ElseIf Target = 3 Or Target = 4 Then
.MarkerBackgroundColorIndex = 6
.MarkerForegroundColorIndex = 6
Else
If Target  "" Then
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
End If
End If
End With
End If
End With
'   Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End Sub

Forumthread: Zellen vergleichen

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Zellen vergleichen

Forumthread: Zellen vergleichen

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread