Array speichern
11.12.2019 08:42:56
Tim
auch ich habe ein (hoffentlich kleines) Excelproblem, bei dem Ihr mir vllt helfen könnt. Erst einmal ein kurzer Hintergrund: Ich möchte Daten aus meiner Tabelle ziehen, diese dann nach ihrer Größe sortieren und die nebenstehenden Daten passend in einen Array schreiben und diese in einem Diagramm wiedergeben (funzt). Nun das Problem: ich muss das mit relativ vielen Zeilen machen. Ich würde also gerne, dass er yArr immer speichert Bsp: yArr(1),yArr(2). Leide funktioniert das nicht. Vllt habt ihr außerdem eine bessere Methode, wie ich den Rangebereich auf ziemlich viele Spalten erweitern kann, sodass ich nicht alles händisch eingeben muss?
Sub Diagrammblatt()
' Formatierung der Daten für das Diagramm
Dim D1 As String
Dim D2 As String
Dim D3 As String
Dim sDatum As String
Dim PD1 As Range
Dim PD2 As Range
Dim PD3 As Range
Dim K1 As Double
Dim K2 As Double
Dim K3 As Double
Dim K4 As Double
Dim Auslastung1 As Double
Dim Auslastung2 As Double
Dim Auslastung3 As Double
Dim Auslastung4 As Double
Dim xArr As Variant
Dim yArr As Variant
Dim rng As Variant
Dim n As Long
Dim i As Long
Dim DatumFormat()
For n = 1 To 2
For Each rng In Array("I4, L4, O4", "I5, L5, O5")
'Sortierung der Werte nach aufsteigendem Datum
D1 = CDate(WorksheetFunction.Small(Range(rng), 1))
Set PD1 = Range(rng).Find(what:=CDate(WorksheetFunction.Small(Range(rng), 1)), lookat:= _
xlWhole)
D2 = CDate(WorksheetFunction.Small(Range(rng), 2))
Set PD2 = Range(rng).Find(what:=CDate(WorksheetFunction.Small(Range(rng), 2)), lookat:= _
xlWhole)
D3 = CDate(WorksheetFunction.Small(Range("I4, L4, O4"), 3))
Set PD3 = Range(rng).Find(what:=CDate(WorksheetFunction.Small(Range(rng), 3)), lookat:= _
xlWhole)
' Zugehörige Auslastung
K1 = PD1.Offset(0, -2)
K2 = PD2.Offset(0, -2)
K3 = PD3.Offset(0, -2)
K4 = Worksheets("PPE").Range("E4")
Auslastung1 = K1 + K2 + K3 + K4
Auslastung2 = K2 + K3 + K4
Auslastung3 = K3 + K4
Auslastung4 = K4
' ändert Arrays für die Nutzung im Diagramm
For i = 1 To 365
ReDim Preserve Abzisse(0, i)
ReDim Preserve Ordinate(0, i)
Abzisse(0, i) = DateAdd("d", i, Date)
Ordinate(0, i) = Auslastung1
Next i
' Anpassung des Arrays für das Diagramm
i = WorksheetFunction.Match(D1, Abzisse, 0)
sDatum = Abzisse(0, i - 1)
For i = i To 365
Ordinate(0, i) = Auslastung2
Next i
'Bis 2. Datum
i = WorksheetFunction.Match(D2, Abzisse, 0)
sDatum = Abzisse(0, i - 1)
For i = i To 365
Ordinate(0, i) = Auslastung3
Next i
'Bis 2. Datum
i = WorksheetFunction.Match(D3, Abzisse, 0)
sDatum = Abzisse(0, i - 1)
For i = i To 365
Ordinate(0, i) = Auslastung4
Next i
' Anpassung des Formates des Datums an das gewünscht "Short Date"
For i = 1 To 365
ReDim Preserve DatumFormat(0, i)
DatumFormat(0, i) = Format(Abzisse(0, i), "Short Date")
Next i
'Genutzte Arrays für das Diagramm
xArr = DatumFormat()
yArr(n) = Ordinate()
Next rng
If xArr = DatumFormat() Then Exit For
Next n
' Auswahl der Tabelle und des Diagrammtypes
With Worksheets("PPE")
.Shapes.AddChart2(276, xlAreaStacked).Select
.Application.CutCopyMode = False
End With
With ActiveChart
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = "='PPE'!$B$4"
.SeriesCollection(1).Values = yArr(1)
.SeriesCollection(1).XValues = xArr
.SeriesCollection(1).Values = yArr(2)
.SeriesCollection(1).XValues = xArr
End With
End Sub