Excel: Vereinfachung eines VBA Codes

Question

Hallo Supporter,

ich habe ein Makro, welches mir in Excel in einem Diagramm folgende Dinge erfüllt:

1. + 2. Es wird der erste + letzte Wert und der Name einer Datenreihe angezeigt
3. Diese Datenreihe wird speziell formatiert.

Wie kann ich diesen VBA Code zusammenfassen? Ich habe insg. 9 Datenreihen (im Beispiel nur 2) - es dauert sehr lange dauert, wenn ich die Daten aktualisiere.

Wir Ihr sehen könnt, ändert sich bei meinen VBA Code nur die "SeriesCollection"

Dem besseren Verstädnis halber habe ich eine Datei beigefügt:

http://www.file-upload.net/download-6778431/VBA.xls.html

Viele Grüße

Stefan


Sub Aktualisieren()
Dim chDiagramm As Chart
Dim inPunkt As Integer
' Wert_1_Ende
Set chDiagramm = ActiveSheet.ChartObjects(1).Chart
With chDiagramm.SeriesCollection(1)
.ApplyDataLabels ShowSeriesName:=True, ShowValue:=True
For inPunkt = 1 To .Points.Count - 1
.Points(inPunkt).DataLabel.Text = ""
Next inPunkt
End With
' Wert_1_Anfang
Set chDiagramm = ActiveSheet.ChartObjects(1).Chart
With chDiagramm.SeriesCollection(1)
.ApplyDataLabels ShowSeriesName:=True
For inPunkt = 2 To .Points.Count - 1
.Points(inPunkt).DataLabel.Text = ""
Next inPunkt
End With
' Wert_1_Ende_Formatierung
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 8
.ColorIndex = 3
End With
' Wert_2_Ende
Set chDiagramm = ActiveSheet.ChartObjects(1).Chart
With chDiagramm.SeriesCollection(2)
.ApplyDataLabels ShowSeriesName:=True, ShowValue:=True
For inPunkt = 1 To .Points.Count - 1
.Points(inPunkt).DataLabel.Text = ""
Next inPunkt
End With
' Wert_2_Anfang
Set chDiagramm = ActiveSheet.ChartObjects(1).Chart
With chDiagramm.SeriesCollection(2)
.ApplyDataLabels ShowSeriesName:=True
For inPunkt = 2 To .Points.Count - 1
.Points(inPunkt).DataLabel.Text = ""
Next inPunkt
End With
' Wert_2_Ende_Formatierung
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.SeriesCollection(2).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 8
.ColorIndex = 3
End With
End Sub

Answer 1

Hi,

versuche es mal so:

Sub Aktualisieren()
Dim intReihe As Integer
With Worksheets("Diagramm").ChartObjects(1).Chart
For intReihe = 1 To .SeriesCollection.Count
With Worksheets("Diagramm").ChartObjects(1).Chart.SeriesCollection(intReihe).Points(1)
.ApplyDataLabels ShowSeriesName:=True, ShowValue:=True
With .DataLabel.Font
.Name = "Arial"
.Bold = True
.Size = 8
.ColorIndex = 3
End With
End With
DoEvents
With .SeriesCollection(intReihe).Points(.SeriesCollection(intReihe).Points.Count)
.ApplyDataLabels ShowSeriesName:=True, ShowValue:=True
With .DataLabel.Font
.Name = "Arial"
.Bold = True
.Size = 8
.ColorIndex = 3
End With
End With
DoEvents
Next intReihe
.Refresh
End With
End Sub

Bis später,
Karin

Answer 2

Hallo Karin,

vielen Dank für Deine Rückmeldung (auch an die, die sich ebenfalls Gedanken gemacht haben)!

Funktioniert (fast) sehr gut: Wenn ich jedoch in Zelle C44 einen längeren Zeitraum auswähle, z.B. 20 Tage, dann werden im Diagramm die Werte von Tag 10 (Ursprungswert) bis 20 angezeigt.

Viele Grüße

Stefan

Answer 3

Hi Stefan,

änder mal die erste With-Anweisung wie folgt:

With .SeriesCollection(intReihe).Points(1)
.Parent.ApplyDataLabels
.Parent.DataLabels.Delete
.ApplyDataLabels ShowSeriesName:=True, ShowValue:=True
With .DataLabel.Font
.Name = "Arial"
.Bold = True
.Size = 8
.ColorIndex = 3
End With
End With

Bis später,
Karin

Answer 4

Hallo Karin,

wunderbar! Es funktioniert jetzt alles einwandfrei! Vielen lieben Dank dafür!

Viele Grüße

Stefan