Liniendiagramm Flächenberechnung

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Jay,
beim ersten Blick fällt auf...
- die Werte gehen vom 1.1. bis 1.12., d.h. das dritte Jahr ist nicht "komplett" - evtl. könntest Du noch den Wert vom 31.12./1.1. des Folgejahres mit anhängen.
- die Errechnung einer "Fläche" benötigt "Längeneinheiten" - "Aktion" und "Monat" sind das nicht. D.h., Du müßtest je einen "Bemaßungskoeffizienten" einführen, also z.B. "Aktion" =! 1, "Monat" =! 10
Die Fläche unterhalb einer Funktion ist das Integral derselben, klar erkannt. Nur: Du hast hier keine Funktion griffbereit, die Du integrieren könntest.
Excel verbindet die Punkte im Diagramm mit einer wie auch immer interpolierten Linie, so daß Dein Wert 0 vom 1.6. zu einem Schwung unter die x-Achse in der Grafik führt.
Soll heißen, es macht einen Unterschied, ob man die Fläche unter dieser interpolierten Linie errechnet oder direkt "linear" aus Deinen Daten.
Letzteres ist relativ simpel...
Userbild

... und läßt sich natürlich auch in VBA umsetzen - falls es Dir so taugt.
Schöne Grüße,
Michael

Sub WerteRein() Dim fy As Double, fx As Double, i As Long Dim aktion As Variant, ausgabe As Variant aktion = Range("B4:AL4") ausgabe = aktion ausgabe(1, 1) = "" fy = Range("b9"): fx = Range("f9") For i = 2 To UBound(aktion, 2) ausgabe(1, i) = fx * fy * (aktion(1, i - 1) + _ (aktion(1, i) - aktion(1, i - 1)) / 2) Next Range("B11").Resize(1, UBound(ausgabe, 2)) = ausgabe End Sub

Sub FormEinfuegen() Dim lngPunkte As Long Dim chrDia As Chart Dim serReihe As Series Dim shaShape As Shape Set chrDia = ActiveSheet.ChartObjects(1).Chart With chrDia If .Shapes.Count > 0 Then For Each shaShape In .Shapes If shaShape.Name = "Flaeche" Then shaShape.Delete Next shaShape End If Set serReihe = chrDia.SeriesCollection(1) With .Shapes.BuildFreeform(msoEditingAuto, serReihe.Points(1).Left, serReihe.Points(1). _ Top) For lngPunkte = 2 To serReihe.Points.Count .AddNodes msoSegmentLine, msoEditingAuto, serReihe.Points(lngPunkte).Left, _ serReihe.Points(lngPunkte).Top Next lngPunkte .AddNodes msoSegmentLine, msoEditingAuto, serReihe.Points(lngPunkte - 1).Left, _ chrDia.Axes(xlCategory).Top .AddNodes msoSegmentLine, msoEditingAuto, serReihe.Points(1).Left, chrDia.Axes( _ xlCategory).Top .AddNodes msoSegmentLine, msoEditingAuto, serReihe.Points(1).Left, serReihe.Points( _ 1).Top .ConvertToShape End With With .Shapes(1) .Fill.Transparency = 0.45 .Fill.ForeColor.RGB = serReihe.Border.Color .Line.Visible = msoFalse .Name = "Flaeche" End With End With End Sub

Sub WerteRein() Dim fy As Double, fx As Double, i As Long Dim aktion As Variant, ausgabe As Variant ' hier wird der angegebene Bereich in das "Array" aktion eingelesen: aktion = Range("B4:AL4") ausgabe = aktion ausgabe(1, 1) = "" fy = Range("b9"): fx = Range("f9") ' ubound(arrayvariable) gibt den "höchsten" Index der Zeilen ' ubound(arrayvariable,2) gibt den "höchsten" Index der Spalten ' eines Arrays zurück, wobei beide nur dann mit der ANZAHL der ' Zeilen bzw. Spalten identisch sind, wenn das Array bei 1 ' beginnt, und das tut es, wenn man einen Bereich einliest. ' Das Gegenstück heißt lbound, das ist der niedrigste Index. For i = 2 To UBound(aktion, 2) ausgabe(1, i) = fx * fy * (aktion(1, i - 1) + _ (aktion(1, i) - aktion(1, i - 1)) / 2) Next Range("B11").Resize(1, UBound(ausgabe, 2)) = ausgabe End Sub

Hi Jay,
dann so:

Sub FormEinfuegenTeilbereich()
Dim lngPunkte As Long
Dim chrDia As Chart
Dim serReihe As Series
Dim shaShape As Shape
Dim lngStart As Variant
Dim arrWerte()
Set chrDia = ActiveSheet.ChartObjects(1).Chart
With chrDia
If .Shapes.Count > 0 Then
For Each shaShape In .Shapes
If shaShape.Name = "Flaeche" Then shaShape.Delete
Next shaShape
End If
Set serReihe = chrDia.SeriesCollection(1)
arrWerte = serReihe.Values
lngStart = Application.Match(CDbl(DateValue("01." & Month(Date) & "." & Year(Date))),  _
Worksheets("Rechnung").Rows("3:3"), 0) - 1
If IsNumeric(lngStart) Then
With .Shapes.BuildFreeform(msoEditingAuto, serReihe.Points(1).Left, serReihe.Points( _
lngStart).Top)
For lngPunkte = lngStart To serReihe.Points.Count
.AddNodes msoSegmentLine, msoEditingAuto, serReihe.Points(lngPunkte).Left,  _
serReihe.Points(lngPunkte).Top
Next lngPunkte
.AddNodes msoSegmentLine, msoEditingAuto, serReihe.Points(lngPunkte - 1).Left,  _
chrDia.Axes(xlCategory).Top
.AddNodes msoSegmentLine, msoEditingAuto, serReihe.Points(lngStart).Left,  _
chrDia.Axes(xlCategory).Top
.AddNodes msoSegmentLine, msoEditingAuto, serReihe.Points(lngStart).Left,  _
serReihe.Points(lngStart).Top
.ConvertToShape
End With
With .Shapes(1)
.Fill.Transparency = 0.45
.Fill.ForeColor.RGB = serReihe.Border.Color
.Line.Visible = msoFalse
.Name = "Flaeche"
End With
End If
End With
End Sub

Beachte, dass die Fläche in der Mitte der jeweiligen Rubrik beginnt bzw. endet, da du die Einstellung der Achsenoption "Zwischen den Teilstrichen" verwendest.

Beliebteste Forumthreads (12 Monate)

Liniendiagramm Flächenberechnung

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread