Laufzeit bei Änderung von Diagrammpunkten zu lange
13.02.2007 10:12:00
Diagrammpunkten
Mein Problem ist Folgendes:
Da Excel ansich kein eigenes Diagramm zur Darstellung eines Portfolios (Diagramm mit Einzeichnung der Punkte aufgrund von x- und y-Koordinaten) bietet, verwende ich ein Punktdiagramm. Da ich in diesem Portfolio weiters zwei verschiedene Punkttypen eintragen möchte, bearbeite ich nach Erstellung des Diagramms jeden Punkt und gebe ihm je nach Inhalt des Kennzeichens eine bestimmte Form und eine bestimmte Farbe.
Das funktioniert auch soweit recht gut, allerdings dauert das bei ca. 400 Punkten schon fast eine Minute!
Hat vielleicht jemand eine Idee, wie ich den folgenden Code "schneller" machen könnte?
Sub PortfolioOhneBeschr()
'Erstellt Portfolio ohne Beschriftung
Dim Punkt As Point
Dim i As Integer
Sheets("Portfolio").Select
ActiveChart.ApplyDataLabels AutoText:=True, LegendKey:=False, _
HasLeaderLines:=False, ShowSeriesName:=False, ShowCategoryName:=False, _
ShowValue:=False, ShowPercentage:=False, ShowBubbleSize:=False
i = 1
With ActiveChart.SeriesCollection(1)
For Each Punkt In .Points
If i > Worksheets("HBM-Entwicklung").Range("Y3") Then
Exit For
End If
If Worksheets("Daten f HBM-Entwicklung").Cells(i + 1, 8) = "NC" Then
Punkt.MarkerStyle = xlMarkerStyleDiamond
Punkt.MarkerBackgroundColor = RGB(0, 100, 255)
Punkt.MarkerForegroundColor = RGB(0, 100, 255)
Else
Punkt.MarkerStyle = xlMarkerStyleCircle
Punkt.MarkerBackgroundColor = RGB(0, 0, 0)
Punkt.MarkerForegroundColor = RGB(0, 0, 0)
End If
i = i + 1
Next Punkt
End With
End Sub
Danke schon mal und liebe Grüße
Anjelo