Diagramm Array uebergibt Werte
Andi
einem ChartObject können die Werte via Array übertragen werden.
Wieviele Werte y/Argumente x können via Array direkt übertragen werden.
With ch.SeriesCollection.NewSeries
.Values = newValues
.XValues = newXValues
End With
Arrays mit mehr als 255 Werten, können nicht direkt zugewiesen werden.
Alternativ bleibt mir nur die eine Krücke übrig.
Dim x as Range
Dim y as Range
Range(Cells(1,1),Cells(Ubound(newValues())+1,1) = newValues()
Range(Cells(1,2),Cells(Ubound(newXValues())+1,2) = NewXValues()
y = Range(Cells(1,1),Cells(Ubound(newValues())+1,1)
x = Range(Cells(1,2),Cells(Ubound(newXValues())+1,2)
With ch.SeriesCollection.NewSeries
.Values = y
.XValues = x
End With
Gibt es hier eine "elegantere" Lösung/Methode oder was gibt es zu beachten?
Anbei ein Beispiel von mir, daß tadellos über die Array Methode läuft.
Function SucessIndex()
Dim WB, SH As Object
Dim k, i As Long
Dim arr() As Variant
Dim arrSortiert() As Variant
Dim Datum As String
Dim DiagrammSheetVorhanden As Boolean
Dim Dia As ChartObject
Dim Reihe As Series
Dim arrX() As Variant
Dim arrY() As Variant
k = 0
For i = 1 To ThisWorkbook.Sheets.Count
If Not "Actual" = ThisWorkbook.Sheets(i).Name And Not Namesheet = ThisWorkbook.Sheets(i) _
_
.Name And Datumvorhanden(ThisWorkbook.Sheets(i).Name) = True Then
Datum = Split(ThisWorkbook.Sheets(i).Name, "|")(2) & "/" & Split(ThisWorkbook.Sheets( _
_
i).Name, "|")(1) & "/" & Split(ThisWorkbook.Sheets(i).Name, "|")(0) & " 00:00:00"
ReDim Preserve arr(0 To k)
arr(k) = CVar("Datum: |" & Datum & " | Index: |" & CStr(Round(ThisWorkbook.Sheets(i). _
_
Cells(48, 12).Value * 100, 2)))
k = k + 1
End If
Next
'Arraysortieren
'Pruefen, ob Array Werte enthaelt
If ArrWerteenthaelt(arr()) = True Then
'Daten werden Datum aufsteigend sortiert
arrSortiert = QuickSort(arr())
'Hilfsarray Inhalte loeschen
Erase arrY()
Erase arrX()
'Sortierte Arraydaten werden den Hilfsarrys dynamisch übertragen
For i = 0 To UBound(arrSortiert())
'Funktionswerte
ReDim Preserve arrY(0 To i)
arrY(i) = CDbl(Split(CStr(arrSortiert(i)), "|")(3))
'Argumente
'Datum wird in den Typ long konvertiert, damit das Steuerelement Chartobject die Werte ü _
_
ber ein Array verarbeiten kann.
ReDim Preserve arrX(0 To i)
arrX(i) = CLng(CDate(Split(CStr(arrSortiert(i)), "|")(1)))
Next
'Diagramm wird initiert
'Wenn vorheriges Diagramm existiert wird es gelöscht und anschliessend ein neues Diagramm
DiagrammSheetVorhanden = False
For i = 1 To ThisWorkbook.Sheets.Count
If ThisWorkbook.Sheets(i).Name = Namesheet Then
Application.DisplayAlerts = False
ThisWorkbook.Sheets(i).Delete
Application.DisplayAlerts = True
Exit For
End If
Next
Set WB = ThisWorkbook
Set SH = WB.Sheets.Add
'Tabellblatt/Diagramm positionieren und umbenennen
SH.Name = Namesheet
SH.Move After:=WB.Sheets("Actual")
SH.Activate
Set Dia = SH.ChartObjects.Add(Left:=50, Width:=800, Top:=75, Height:=255)
Dia.Chart.ChartType = xlLineMarkers
Dia.Activate
'Array Wertepaare werden dem Steuerelement Chartobjekt übergeben
With Dia.Chart.SeriesCollection.NewSeries
.Name = CStr(WB.Sheets("Actual").Cells(4, 5)) & Chr(10) & Chr(10) & "Success Index _
Chart"
.Values = arrY()
.XValues = arrX()
End With
SH.ChartObjects(1).Activate
ActiveChart.Axes(xlCategory).TickLabels.NumberFormat = "dd/mm/yyyy;@"
With ActiveChart.Axes(xlCategory).TickLabels
.Alignment = xlCenter
.Offset = 80
.ReadingOrder = xlContext
.Orientation = xlUpward
End With
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScaleIsAuto = True
.MaximumScale = 100
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
With ActiveChart
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "[%]"
End With
SH.Cells(1, 1).Select
'WB.Sheets("Actual").Activate
End If
Set SH = Nothing
Set WB = Nothing
Set Dia = Nothing
End Function
Gruß
Andi