Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1572to1576
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
Inhaltsverzeichnis

Grafik mit VBA: Gewisse Datensätze ausklammern

Grafik mit VBA: Gewisse Datensätze ausklammern
17.08.2017 17:00:38
Chris
Hallo liebes Forum,
ich hab ein kleines Problem mit einem VBA-Code, welches ich gerade trotz mehrerer Versuche nicht mehr selbst gelöst bekomme. Der eigentliche Code funktioniert zwar super aber ich will diesen etwas überarbeiten und komme hier nicht weiter.
Der Code (siehe Ende) wertet Daten einer Spalte aus und zeichnet aufgrund dessen in einer neuen Lasche verschieden lange Linien, welche allesamt dann eine Grafik ergeben. In besagter Spalte befinden sich unsortiert Werte zwischen 1 und 7, welche auch unsortiert bleiben müssen. Der Code funktioniert wunderbar, ich würde diesen nun jedoch gerne so überarbeiten, dass er für alle Werte außer "1" diese Linien zeichnet. Bisher habe ich es mit einer Hilfstabelle gelöst, die alle Daten ohne die "1" übernimmt und hierauf dann den Code angewandt, ich würde es jedoch gerne langfristig ohne Hilfstabelle lösen.
Ich hoffe ich konnte halbwegs erklären was ich meine und hoffe ihr könnt mir weiterhelfen.
Vielen Dank bereits vorab und liebe Grüße,
Chris
Im Folgenden noch der Code:
Sub Draw_lines()
Dim i As Integer
Dim Length As Integer
Dim pixeljump As Integer
Dim j As Integer
Dim k As Integer
i = 2
Length = 0
pixeljump = 11
j = 0
k = 0
'Löscht potentiell existierende Grafiken
For k = GRAFIK.Shapes.Count To 1 Step -1
GRAFIK.Shapes(k).Delete
Next
Do Until DATA.Cells(i, 17) = ""
Length = DATA.Cells(i, 17)
'Die if-Formel prüft (auf rudimentäre Weise) ob sich die Stadt geändert hat. Falls ja wird  _
ein größere Sprung veranlasst
If DATA.Cells(i, 2) = DATA.Cells(i - 1, 2) Then
Else
j = j + 1
End If
'Adds Line
With GRAFIK.Shapes.AddShape(msoShapeRectangle, 10 + ((i + j) * pixeljump), 10, 2,  _
Length * 50)
.Fill.ForeColor.RGB = RGB(244, 216, 166)
.Line.Visible = msoFalse
End With
'Adds first circle
With GRAFIK.Shapes.AddShape(msoShapeOval, 8.5 + ((i + j) * pixeljump), 8, 5, 5)
.Fill.ForeColor.RGB = RGB(215, 43, 85)
.Line.Visible = msoFalse
End With
'Adds end circle
With GRAFIK.Shapes.AddShape(msoShapeOval, 6 + ((i + j) * pixeljump), (Length + 0.1) *  _
50, 10, 10)
.Fill.ForeColor.RGB = RGB(68, 84, 106)
.Line.Visible = msoFalse
End With
i = i + 1
Loop
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Grafik mit VBA: Gewisse Datensätze ausklammern
17.08.2017 17:37:49
Werner
Hallo Chris,
das sollte doch so gehen:
Sub Draw_lines()
Dim i As Integer
Dim Length As Integer
Dim pixeljump As Integer
Dim j As Integer
Dim k As Integer
i = 2
Length = 0
pixeljump = 11
j = 0
k = 0
'Löscht potentiell existierende Grafiken
For k = GRAFIK.Shapes.Count To 1 Step -1
GRAFIK.Shapes(k).Delete
Next
Do Until Data.Cells(i, 17) = ""
If Data.Cells(i, 17) > 1 Then
Length = Data.Cells(i, 17)
'Die if-Formel prüft (auf rudimentäre Weise) ob sich die Stadt geändert hat. Falls ja wird  _
_
ein größere Sprung veranlasst
If Data.Cells(i, 2) = Data.Cells(i - 1, 2) Then
Else
j = j + 1
End If
'Adds Line
With GRAFIK.Shapes.AddShape(msoShapeRectangle, 10 + ((i + j) * pixeljump), 10, 2, _
Length * 50)
.Fill.ForeColor.RGB = RGB(244, 216, 166)
.Line.Visible = msoFalse
End With
'Adds first circle
With GRAFIK.Shapes.AddShape(msoShapeOval, 8.5 + ((i + j) * pixeljump), 8, 5, 5)
.Fill.ForeColor.RGB = RGB(215, 43, 85)
.Line.Visible = msoFalse
End With
'Adds end circle
With GRAFIK.Shapes.AddShape(msoShapeOval, 6 + ((i + j) * pixeljump), (Length + 0.1) * _
50, 10, 10)
.Fill.ForeColor.RGB = RGB(68, 84, 106)
.Line.Visible = msoFalse
End With
i = i + 1
End If
Loop
End Sub
Ist aber ungetestet.
Gruß Werner
Anzeige
AW: Grafik mit VBA: Gewisse Datensätze ausklammern
18.08.2017 15:57:50
Chris
Hallo Werner,
da hängt es sich leider auf und ich kann nicht nachvollziehen warum...
Hast du eine Idee?
Beste Grüße,
Chris
AW: Grafik mit VBA: Gewisse Datensätze ausklammern
19.08.2017 13:55:44
Werner
Hallo Chris,
ich schon, lass den Code mal im Einzelstep laufen, dann siehst du es vermutlich auch.
Sobald der Code eine Zeile erwischt, in der in Spalte Q eine 1 steht springt er ganz zum End If am Ende des Codes. Über den Loop gehts dann zurück zum Loop until. Problem dabei, du erhöhst den Zeilenzähler i vor diesem End If. Bedeutet, dass du immer wieder die gleiche Zeile auf 1 überprüfst und du dadurch in einer Endlosschleife hängst.
Bedeutet: Das i = i + 1 muss nach dem End If stehen.
Zudem sprichst du hier Data.Cells.... und GRAFIK.Cells... an. In deinem Code ist aber Data und GRAFIK nirgendwo Deklariert und auch nirgendwo zugewiesen.
Was ist Data und GRAFIK? Tabellenblätter?
Davon bin ich mal ausgegangen und habe sie entsprechend Deklariert und zugewiesen.
Data --> "Tabelle1", GRAFIK --> "Tabelle2".
Das musst du entsprechend anpassen.
Sub Draw_lines()
Dim i As Integer
Dim Length As Integer
Dim pixeljump As Integer
Dim j As Integer
Dim k As Integer
Dim Data As Worksheet
Dim GRAFIK As Worksheet
Set Data = Worksheets("Tabelle1") 'anpassen
Set GRAFIK = Worksheets("Tabelle2") 'anpassen
i = 2
Length = 0
pixeljump = 11
j = 0
k = 0
'Löscht potentiell existierende Grafiken
For k = GRAFIK.Shapes.Count To 1 Step -1
GRAFIK.Shapes(k).Delete
Next
Do Until Data.Cells(i, 17) = ""
If Data.Cells(i, 17) > 1 Then
Length = Data.Cells(i, 17)
If Data.Cells(i, 2) = Data.Cells(i - 1, 2) Then
Else
j = j + 1
End If
'Adds Line
With GRAFIK.Shapes.AddShape(msoShapeRectangle, 10 + ((i + j) * pixeljump), 10, 2, _
Length * 50)
.Fill.ForeColor.RGB = RGB(244, 216, 166)
.Line.Visible = msoFalse
End With
'Adds first circle
With GRAFIK.Shapes.AddShape(msoShapeOval, 8.5 + ((i + j) * pixeljump), 8, 5, 5)
.Fill.ForeColor.RGB = RGB(215, 43, 85)
.Line.Visible = msoFalse
End With
'Adds end circle
With GRAFIK.Shapes.AddShape(msoShapeOval, 6 + ((i + j) * pixeljump), (Length + 0.1) * _
50, 10, 10)
.Fill.ForeColor.RGB = RGB(68, 84, 106)
.Line.Visible = msoFalse
End With
End If
i = i + 1
Loop
End Sub
Gruß Werner
Anzeige
AW: Grafik mit VBA: Gewisse Datensätze ausklammern
19.08.2017 14:55:01
Chris
Hallo Werner,
super! Dankeschön. Soweit klappt es jetzt. :)
Ein kleines Problem besteht noch bzw. hat sich daraus neu ergeben.
Es zeichnet nun wie gewollt die Linien für die Werte mit "1" nicht. Dadurch reiht es mir die Linien aber nicht direkt aneinander sondern lässt für die "1er" eben immer Platz frei. Ich hätte jedoch gerne, dass die Linien direkt aneinander gereiht sind und es für die "1er" keinen Platz lässt, sondern diese einfach überspringt und trotzdem direkt aneinanderreiht. Es soll lediglich einen kleinen Sprung machen, wenn sich die Stadt ändert, also der Wert in Spalte A - das steht aber schon so im VBA-Code - anscheinend wird das davon aber auch tangiert.
Puh, fällt mir gar nicht so leicht das zu beschreiben. Ich versuche mal etwas mit hochzuladen. Ich hoffe dadurch verstehst du besser was ich meine. Muss leider einige Daten löschen, da diese vertraulich sind aber es sollte trotzdem nachvollziehbar sein.
Datei unter: https://www.herber.de/bbs/user/115585.xlsm
Beste Grüße und vielen Dank schon mal bzw. nochmals!
Chris
Anzeige
AW: Grafik mit VBA: Gewisse Datensätze ausklammern
20.08.2017 12:08:18
Werner
Hallo Chris,
kann im Moment keine .xlsm herunterladen, von daher kann ich mir deine Datei auch nicht anschauen.
Du schreibst hier: Bei Änderung der Stadt in Spalte A
Bei dir im Code überprüfst du aber Spalte B auf Änderungen und nicht Spalte A (das habe ich auch so gelassen).
Teste mal:
Sub Draw_Lines()
Dim i As Integer
Dim Length As Integer
Dim pixeljump As Integer
Dim j As Integer
Dim k As Integer
Dim zähler As Integer
Dim Data As Worksheet
Dim GRAFIK As Worksheet
Set Data = Worksheets("Tabelle1") 'anpassen
Set GRAFIK = Worksheets("Tabelle3") 'anpassen
i = 2
Length = 0
pixeljump = 11
j = 0
k = 0
For k = GRAFIK.Shapes.Count To 1 Step -1
GRAFIK.Shapes(k).Delete
Next
Do Until Data.Cells(i, 17) = ""
'nur wenn schon ein Shape vorhanden ist
'verhindert das Einfügen vor dem ersten Shape
If GRAFIK.Shapes.Count > 0 Then
'wenn Zelle nicht leer
If Data.Cells(i, 2)  "" Then
If Data.Cells(i, 2) = Data.Cells(i - 1, 2).Value Then
Else
j = j + 1
End If
End If
End If
If Data.Cells(i, 17) > 1 Then
Length = Data.Cells(i, 17)
With GRAFIK.Shapes.AddShape(msoShapeRectangle _
, 10 + ((i + j + zähler) * pixeljump), 10, 2, Length * 50)
.Fill.ForeColor.RGB = RGB(244, 216, 166)
.Line.Visible = msoFalse
End With
With GRAFIK.Shapes.AddShape(msoShapeOval _
, 8.5 + ((i + j + zähler) * pixeljump), 8, 5, 5)
.Fill.ForeColor.RGB = RGB(215, 43, 85)
.Line.Visible = msoFalse
End With
With GRAFIK.Shapes.AddShape(msoShapeOval _
, 6 + ((i + j + zähler) * pixeljump), (Length + 0.1) * 50, 10, 10)
.Fill.ForeColor.RGB = RGB(68, 84, 106)
.Line.Visible = msoFalse
End With
Else
zähler = zähler - 1
End If
i = i + 1
Loop
End Sub
Gruß Werner
Anzeige
AW: Grafik mit VBA: Gewisse Datensätze ausklammern
20.08.2017 13:35:48
Chris
Super! Jetzt klappt es genau so wie ich es haben wollte!
Vielen lieben Dank für die ausführliche Hilfe! Das hat mir wirklich einiges an Kopfzerbrechen erspart. :)
Beste Grüße und einen schönen Sonntag,
Chris
AW: Grafik mit VBA: Gewisse Datensätze ausklammern
20.08.2017 19:44:56
Werner
Gerne u. Danke für die Rückmeldung. o.w.T.
21.08.2017 02:38:43
Werner

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige