Tages-Diagramme autom. erstellen

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tages-Diagramme autom. erstellen

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread