Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
988to992
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
988to992
988to992
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Chart to slow

Chart to slow
07.07.2008 10:36:44
Rosenwasser
Hallo,
Die unterstehende Code funktioniert ziemlich schnell mit Excel 2003.
Bei Ausführung mit Excel 2007 wird die Geschwindigkeit dramatisch langsam.
Wie kann ich diese Code schneller laufen lassen in Excel 2007?
Vielen Dank

Sub BalkenKleur()
Dim i As Integer
Dim x As Integer
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlNone
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With ActiveChart.ChartGroups(1)
.Overlap = 0
.GapWidth = 0
.HasSeriesLines = False
.VaryByCategories = False
End With
On Error GoTo ERRORHANDLER
Application.ScreenUpdating = False
ActiveChart.SeriesCollection(1).ApplyDataLabels Type:=xlDataLabelsShowValue, _
AutoText:=True
For x = 1 To ActiveChart.SeriesCollection.Count
For i = 1 To ActiveChart.SeriesCollection(x).Points.Count
ActiveChart.SeriesCollection(x).Points(i).DataLabel.Select
If CDbl(Selection.Text) = "5" Then
ActiveChart.SeriesCollection(x).Points(i).Interior.ColorIndex = 3
ElseIf CDbl(Selection.Text) >= "4,5" Then
ActiveChart.SeriesCollection(x).Points(i).Interior.ColorIndex = 3
ElseIf CDbl(Selection.Text) >= "4" Then
ActiveChart.SeriesCollection(x).Points(i).Interior.ColorIndex = 22
ElseIf CDbl(Selection.Text) >= "3,5" Then
ActiveChart.SeriesCollection(x).Points(i).Interior.ColorIndex = 46
ElseIf CDbl(Selection.Text) >= "3" Then
ActiveChart.SeriesCollection(x).Points(i).Interior.ColorIndex = 45
ElseIf CDbl(Selection.Text) >= "2,5" Then
ActiveChart.SeriesCollection(x).Points(i).Interior.ColorIndex = 40
ElseIf CDbl(Selection.Text) >= "2" Then
ActiveChart.SeriesCollection(x).Points(i).Interior.ColorIndex = 44
ElseIf CDbl(Selection.Text) >= "1,5" Then
ActiveChart.SeriesCollection(x).Points(i).Interior.ColorIndex = 36
ElseIf CDbl(Selection.Text) >= "1" Then
ActiveChart.SeriesCollection(x).Points(i).Interior.ColorIndex = 50
ElseIf CDbl(Selection.Text) >= "0,5" Then
ActiveChart.SeriesCollection(x).Points(i).Interior.ColorIndex = 43
End If
Next i
Next x
ActiveChart.SeriesCollection(1).ApplyDataLabels Type:=xlDataLabelsShowNone, _
AutoText:=True
Application.ScreenUpdating = True
Exit Sub
ERRORHANDLER:
MsgBox "De procedure is vastgelopen"
End Sub


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

Betreff
Datum
Anwender
Anzeige
AW: Chart to slow
07.07.2008 18:37:00
Beverly
Hi,
ich habe den folgenden Code nicht getestet, weil ich das Beispiel nicht nachbauen will, denn ein Nachbau entspricht nicht dem Original. Versuche es mal so (der Code gilt für ein in das Tabellenblatt eingebettetes Diagrammobjekt):

Sub BalkenKleur()
Dim i As Integer
Dim x As Integer
Dim chDiagramm As Chart
Set chDiagramm = ActiveSheet.ChartObjects(1).Chart
With chDiagramm
With .SeriesCollection(1).Border
.Weight = xlHairline
.LineStyle = xlNone
End With
.SeriesCollection(1).Shadow = False
.SeriesCollection(1).InvertIfNegative = False
With .ChartGroups(1)
.Overlap = 0
.GapWidth = 0
.HasSeriesLines = False
.VaryByCategories = False
End With
'    On Error GoTo ERRORHANDLER
Application.ScreenUpdating = False
.SeriesCollection(1).ApplyDataLabels Type:=xlDataLabelsShowValue, _
AutoText:=True
For x = 1 To .SeriesCollection.Count
For i = 1 To .SeriesCollection(x).Points.Count
With .SeriesCollection(x).Points(i)
If CDbl(.DataLabel.Text) = "5" Then
.Interior.ColorIndex = 3
ElseIf CDbl(.DataLabel.Text) >= "4,5" Then
.Interior.ColorIndex = 3
ElseIf CDbl(.DataLabel.Text) >= "4" Then
.Interior.ColorIndex = 22
ElseIf CDbl(.DataLabel.Text) >= "3,5" Then
.Interior.ColorIndex = 46
ElseIf CDbl(.DataLabel.Text) >= "3" Then
.Interior.ColorIndex = 45
ElseIf CDbl(.DataLabel.Text) >= "2,5" Then
.Interior.ColorIndex = 40
ElseIf CDbl(.DataLabel.Text) >= "2" Then
.Interior.ColorIndex = 44
ElseIf CDbl(.DataLabel.Text) >= "1,5" Then
.Interior.ColorIndex = 36
ElseIf CDbl(.DataLabel.Text) >= "1" Then
.Interior.ColorIndex = 50
ElseIf CDbl(.DataLabel.Text) >= "0,5" Then
.Interior.ColorIndex = 43
End If
End With
Next i
Next x
End With
Application.ScreenUpdating = True
Set chDiagramm = Nothing
'   Exit Sub
'ERRORHANDLER:
'    MsgBox "De procedure is vastgelopen"
End Sub



Anzeige
AW: Chart to slow
07.07.2008 20:15:00
Rosenwasser
Hallo,
Vielen Dank für ihre Hilfe.
Ich habe versucht diese Code einzufügebn.
Folgende Punkten sind mir aufgefallen:
1) Diese Code wird 4x hintereinander aufgerufen, dieses um 4 separate Diagrammen zu erstellen.
Nur bei den ersten Diagramm erscheinen die unterschiedlichen Farben, bei die drei anderen nicht.
2) In das erste Diagramm dürfen die Werten von Data Labels nicht wiedergegeben werden.
Wo können die Fehler liegen?

AW: Chart to slow
07.07.2008 22:55:09
Beverly
Hi,
ich kenne weder deine Arbeitsmappe noch ging aus deinem Code hervor, was das ActiveChart ist und dass der Code 4 mal durchlaufen wird. Deshalb habe ich einfach angenommen, dass es das Diagramm Nr. 1 im aktiven Tabellenblatt ist. Das geschieht in dieser Codezeile

Set chDiagramm = ActiveSheet.ChartObjects(1).Chart


Du musst also die 1 durch eine Variable ersetzen, die dem betreffenden Diagramm entspricht. In einer zusätzlichen Bedingung musst du dann noch festlegen, dass bei dem Diagramm Nr. 1 die Beschriftungslabel nicht angezeigt werden sollen.


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