Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 07:57:54
Tablle fürs E-Auto - Preis wenn kürzer als 60 Min Ladezeit
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
860to864
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
860to864
860to864
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

860to864: Datenpunktfarbe, abhaengig.....

Datenpunktfarbe, abhaengig.....
05.04.2007 14:38:00
th.heinrich
bestes Forum,
mit folgendem code wird zellen in abhaengigkeit des inhaltes eine farbe zugewiesen.

Sub farbe()
Dim rng As Range
Dim bereich As Range
Set bereich = [I2:I100]
[I2:I100].Interior.ColorIndex = xlNone
For Each rng In bereich
If rng  "" Then
'If Intersect(Target, Range("k2:k55")) Is Nothing Then Exit Sub
Select Case rng
Case "30 Q83 BW3:FixM", "60 Q83 BW3:FixM"
rng.Interior.ColorIndex = 3
Case "30 Q83 BW3:1015", "60 Q83 BW3:1015"
rng.Interior.ColorIndex = 22
Case "30 Q83 BW3:1815", "60 Q83 BW3:1815"
rng.Interior.ColorIndex = 40
Case "30 Q83 BW4:FixM", "60 Q83 BW4:FixM"
rng.Interior.ColorIndex = 4
Case "30 Q83 BW4:1015", "60 Q83 BW4:1015"
rng.Interior.ColorIndex = 8
Case "30 Q83 BW4:1815", "60 Q83 BW4:1815"
rng.Interior.ColorIndex = 34
Case "30 Q2000 BW3:FixM", "60 Q2000 BW3:FixM"
rng.Interior.ColorIndex = 39
Case "30 Q2000 BW3:1015", "60 Q2000 BW3:1015"
rng.Interior.ColorIndex = 37
Case "30 Q2000 BW3:1815", "60 Q2000 BW3:1815"
rng.Interior.ColorIndex = 41
Case "30 Q2000 BW4:FixM", "60 Q2000 BW4:FixM"
rng.Interior.ColorIndex = 36
Case "30 Q2000 BW4:1015", "60 Q2000 BW4:1015"
rng.Interior.ColorIndex = 6
Case "30 Q2000 BW4:1815", "60 Q2000 BW4:1815"
rng.Interior.ColorIndex = 44
End Select
End If
Next
End Sub
wie ist es nun machbar den Datenpunkten eines diagramms anhand obiger beschriftungen dieselben farben zuzuweisen. es handelt sich um eine Datenreihe.
vielen dank fuer Eure hilfe
thomas

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datenpunktfarbe, abhaengig.....
05.04.2007 17:44:00
Herbert
hallo Thomas,
in etwa so:

Public Sub dp_färben_1()
Dim pkt As Point
Application.ScreenUpdating = False
With ActiveSheet.ChartObjects(1).Chart
.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=True
For Each pkt In .SeriesCollection(1).Points
Select Case pkt.DataLabel.Text
Case "30 Q83 BW3:FixM"
pkt.Interior.ColorIndex = 3
Case "30 Q83 BW3:1015"
pkt.Interior.ColorIndex = 22
Case "30 Q83 BW3:1815"
pkt.Interior.ColorIndex = 40
Case "30 Q83 BW4:FixM"
pkt.Interior.ColorIndex = 4
Case "30 Q83 BW4:1015"
pkt.Interior.ColorIndex = 8
End Select
Next
.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=False
End With
End Sub
gruß Herbert
Anzeige
AW: Datenpunktfarbe, abhaengig.....
05.04.2007 17:44:00
Herbert
hallo Thomas,
in etwa so:

Public Sub dp_färben_1()
Dim pkt As Point
Application.ScreenUpdating = False
With ActiveSheet.ChartObjects(1).Chart
.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=True
For Each pkt In .SeriesCollection(1).Points
Select Case pkt.DataLabel.Text
Case "30 Q83 BW3:FixM"
pkt.Interior.ColorIndex = 3
Case "30 Q83 BW3:1015"
pkt.Interior.ColorIndex = 22
Case "30 Q83 BW3:1815"
pkt.Interior.ColorIndex = 40
Case "30 Q83 BW4:FixM"
pkt.Interior.ColorIndex = 4
Case "30 Q83 BW4:1015"
pkt.Interior.ColorIndex = 8
End Select
Next
.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=False
End With
End Sub
gruß Herbert
Anzeige
Datenpunktfarbe, abhaengig, vielen dank
06.04.2007 17:25:00
th.heinrich
hallo Herbert,
besten dank, wieder einmal eine Deiner tollen loesungen. fuer mein heim xl97 musste ich nochwas aendern.

Public Sub dp_färben_2()
Dim pkt As Point
Application.ScreenUpdating = False
With ActiveSheet.ChartObjects(1).Chart
'.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=True
'damit konnte mein heim xl97 nichst anfangen.
.SeriesCollection(2).ApplyDataLabels Type:=xlDataLabelsShowLabel
For Each pkt In .SeriesCollection(2).Points
Select Case pkt.DataLabel.Text
Case "30 Q83 BW3:FixM", "60 Q83 BW3:FixM"
pkt.Interior.ColorIndex = 3
Case "30 Q83 BW3:1015", "60 Q83 BW3:1015"
pkt.Interior.ColorIndex = 22
Case "30 Q83 BW3:1815", "60 Q83 BW3:1815"
pkt.Interior.ColorIndex = 40
Case "30 Q83 BW4:FixM", "60 Q83 BW4:FixM"
pkt.Interior.ColorIndex = 4
Case "30 Q83 BW4:1015", "60 Q83 BW4:1015"
pkt.Interior.ColorIndex = 8
Case "30 Q83 BW4:1815", "60 Q83 BW4:1815"
pkt.Interior.ColorIndex = 34
Case "30 Q2000 BW3:FixM", "60 Q2000 BW3:FixM"
pkt.Interior.ColorIndex = 39
Case "30 Q2000 BW3:1015", "60 Q2000 BW3:1015"
pkt.Interior.ColorIndex = 37
Case "30 Q2000 BW3:1815", "60 Q2000 BW3:1815"
pkt.Interior.ColorIndex = 41
Case "30 Q2000 BW4:FixM", "60 Q2000 BW4:FixM"
pkt.Interior.ColorIndex = 36
Case "30 Q2000 BW4:1015", "60 Q2000 BW4:1015"
pkt.Interior.ColorIndex = 6
Case "30 Q2000 BW4:1815", "60 Q2000 BW4:1815"
pkt.Interior.ColorIndex = 44
End Select
Next
'.SeriesCollection(1).ApplyDataLabels ShowCategoryName:=False
.SeriesCollection(2).ApplyDataLabels Type:=xlNone
End With
End Sub
frohe ostertage von
thomas
Anzeige

Links zu Excel-Dialogen

Label

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige