Tages-Diagramme autom. erstellen

Forumthread: Tages-Diagramme autom. erstellen

18.02.2020 08:14:18

Christian

Hallo Forum,
nachdem ich nun schon viele Infos und Lösungen aus dem Forum umgesetzt habe bin ich aktuell ratlos.
Vielleicht ist das auch gar nicht machbar.
Es handelt sich um eine Auswertungen des Blutzuckerspiegels.
Ich habe eine Tabelle mit 2 Spalten und etwa 8.500 Zeilen (90 Tage).
[A] = [Datum Uhrzeit] und [B] = [Wert]
Format [Datum Uhrzeit] = 18.02.2020 01:56
Format [Wert] = Ganze Zahl zwischen 50 und 300
Pro Tag gibt es ca. 100 Werte (etwa alle 15 Minuten).
Das Ganze sieht auszugsweise so aus: https://i.imgur.com/7IuSk3x.png
20.01.2020 22:46 | 116
20.01.2020 23:01 | 112
20.01.2020 23:16 | 116
20.01.2020 23:31 | 116
20.01.2020 23:46 | 113
21.01.2020 00:01 | 111
21.01.2020 00:16 | 111
21.01.2020 00:31 | 109
21.01.2020 00:46 | 105
21.01.2020 01:01 | 101
21.01.2020 01:16 | 101
21.01.2020 01:31 | 102
21.01.2020 01:46 | 102
Nun möchte ich daraus automatisch 90 Tagesdiagramme in ein neues Tabellenblatt generieren lassen.
Diagrammtitel: Tagesdatum
Achsenbeschriftung: Uhrzeit
Es soll noch ein Bereich davon farblich hinterlegt werden (Sollbereich von 90 - 130) aber ich denke mal das schaffe ich dann schon.
Das Resultat sollte etwa so aussehen: https://i.imgur.com/ZTjKGpO.png
Ist das möglich?
Ich bedanke mich jetzt schon für Vorschläge.
Schönen Gruß
Christian

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Tages-Diagramme autom. erstellen

18.02.2020 09:57:42

Christian
AW: Tages-Diagramme autom. erstellen

18.02.2020 11:20:36

Beverly
AW: Tages-Diagramme autom. erstellen

18.02.2020 12:46:25

Christian
AW: Tages-Diagramme autom. erstellen

18.02.2020 16:04:48

Beverly
Gelöst - Vielen Dank

18.02.2020 21:24:13

Christian
AW: Gelöst - Vielen Dank

18.02.2020 21:59:01

Beverly

AW: Tages-Diagramme autom. erstellen

18.02.2020 09:57:42

Christian

Ich habe hier mal eine Tabelle mit Demodaten raufgeladen: https://www.herber.de/bbs/user/135263.xlsx

AW: Tages-Diagramme autom. erstellen

18.02.2020 11:20:36

Beverly

Hi Christian,
deine Links laufen ins Nirvana - es wird nichts angezeigt.
Erstelle doch einfach mal 1 Diagramm und formatiere es so wie es nach deinen Wünschen aussehen sollte.

AW: Tages-Diagramme autom. erstellen

18.02.2020 12:46:25

Christian

Oh, Sorry, da ist mir wohl ein Fehler passiert.
Hier eine Datei mit Diagrammen wie es aussehen soll.
https://www.herber.de/bbs/user/135267.xlsx

AW: Tages-Diagramme autom. erstellen

18.02.2020 16:04:48

Beverly

Definiere 2 Namen:
Oben =39+ZEILE(Diagramme1!$1:$2)/ZEILE(Diagramme1!$1:$2)
Unten =89+ZEILE(Diagramme1!$1:$2)/ZEILE(Diagramme1!$1:$2)
Dann kannst du mit folgendem Code die Diagramme erstellen:

Sub DiasErstellen()
Dim lngZeile As Long
Dim lngLetzte As Long
Dim lngStart As Long
Dim lngZiel As Long
Dim intReihe As Integer
Dim chrDia As ChartObject
Dim dblMax As Double
lngZiel = 2
lngStart = 7
With Worksheets("Werte")
lngLetzte = .Columns(1).Find(What:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
For lngZeile = 7 To lngLetzte
If Day(.Cells(lngZeile, 1))  Day(.Cells(lngZeile + 1, 1)) Then
Set chrDia = Worksheets("Diagramme").ChartObjects.Add(0, 0, 0, 0)
chrDia.Chart.ChartType = xlLine
chrDia.Chart.HasTitle = True
chrDia.Chart.ChartTitle.Caption = Format(Worksheets("Werte").Cells(lngZeile, 1), _
"dd.mm.yyyy")
chrDia.Chart.HasLegend = False
If chrDia.Chart.SeriesCollection.Count > 0 Then
For intReihe = chrDia.Chart.SeriesCollection.Count To 1 Step -1
chrDia.Chart.SeriesCollection(intReihe).Delete
Next intReihe
End If
With chrDia.Chart.SeriesCollection.NewSeries
.Values = Worksheets("Werte").Range("C" & lngStart & ":C" & lngZeile)
.XValues = Worksheets("Werte").Range("B" & lngStart & ":B" & lngZeile)
End With
With chrDia.Chart.SeriesCollection.NewSeries
.Values = "='" & ThisWorkbook.Name & "'!Unten"
.ChartType = xlAreaStacked
.AxisGroup = 2
.Format.Fill.Visible = msoFalse
End With
With chrDia.Chart.SeriesCollection.NewSeries
.Values = "='" & ThisWorkbook.Name & "'!Oben"
.ChartType = xlAreaStacked
.AxisGroup = 2
With .Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.400000006
.Transparency = 0.55
.Solid
End With
End With
chrDia.Chart.SetElement (msoElementSecondaryCategoryAxisShow)
With chrDia.Chart.Axes(xlCategory, xlSecondary)
.Format.Line.Visible = msoFalse
.AxisBetweenCategories = False
.TickLabelPosition = xlNone
End With
Application.EnableEvents = True
lngStart = lngZeile + 1
End If
Next lngZeile
End With
With Worksheets("Diagramme")
For lngZeile = 1 To .ChartObjects.Count
With .ChartObjects(lngZeile)
.Top = .Parent.Cells(lngZiel, 1).Top
.Width = .Parent.Columns("B:M").Width
.Height = .Parent.Rows("2:15").Height
dblMax = .Chart.Axes(xlValue, xlPrimary).MaximumScale
.Chart.Axes(xlValue, xlSecondary).MaximumScale = dblMax
End With
lngZiel = lngZiel + 16
Next lngZeile
.Columns(1).Insert
End With
End Sub

Gelöst - Vielen Dank

18.02.2020 21:24:13

Christian

Wow Beverly,
ich bin beeindruckt.
Funktioniert wie gewünscht.
Die Namensdefinition musst ich anpassen (Diagramme statt Diagramme1) dann hat alles funktioniert.
Ich muss mich jetzt nur noch hinsetzten um das alles zu verstehen :-)
Vielen Dank für die prompte Hilfe.
... schönen Abend noch

AW: Gelöst - Vielen Dank

18.02.2020 21:59:01

Beverly

Hi Christian,
falls du Fragen zum Code hast - einfach nachfragen.

Beliebteste Forumthreads (12 Monate)

Forumthread: Tages-Diagramme autom. erstellen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread