Registriert seit: 13.08.2017
Version(en): 2016
Hallo Forum,
folgender Code legt ein Chart einer Häufigkeitsverteilung an
'Häufigk.Chart anlegen
Set oChart = ActiveSheet.ChartObjects.Add(500, 100, 300, 200)
With oChart.Chart
.SetSourceData Source:=Range("$A$1:$B$10")
.ClearToMatchStyle
.ChartStyle = 238
.ChartTitle.Characters.Text = "Häufigkeiten"
End With
Wie lassen sich "Range A1:A10 (Klassen) und B1:B10 (Häufigkeiten)" durch 2 nicht tabellengebunde Arrays ersetzen?
MfG
Rolf Beißner
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallöchen,
Du bildest für jede Sriescollection ein Array oder korrekterweise einen String der ein Array darstellt, z.B.
arrSeCol(1) = "={-0.5,0.5,-1.38}"
arrSeCol(1) = "={-0.5,0.5,-1.38}"
und tust die Arrays dann in einer Schleife zuweisen, z.B.
Code:
For iCnt = 1 To 2
.SeriesCollection.NewSeries
With .SeriesCollection(iCnt)
.XValues = ""
.Values = arrSeCol(iCnt, 1)
.Name = arrSeCol(iCnt, 2)
.Border.Color = arrSeCol(iCnt, 3)
.Format.Line.Weight = 0.25
End With
Next
Das Codestück hier erstellt eine neue SC und weist neben den 3 Werten auch Name und Farben zu, daher im Beispiel das 2D-Array.
Für das Eintragen der Werte könnte das so aussehen:
Code:
arrSeCol(1) = "={-0.5,0.5,-1.38}"
arrSeCol(1) = "={-0.5,0.5,-1.38}"
For iCnt = 1 To 2
With .SeriesCollection(iCnt)
.XValues = ""
.Values = arrSeCol(iCnt)
End With
Next
Allerdings hat(te?) sich Excel da etwas eigen und hat mir damals die Farben der SC's verhauen ..
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 13.08.2017
Version(en): 2016
Hallo André,
danke für den Tipp.
Auf mein Anliegen zugeschnitten, sieht der Code so aus:
Sub ChartViaSeriesCollection()
Dim wks As Worksheet
Dim co As ChartObject
Dim s1 As Series, s2 As Series
Set wks = Sheets.Add
If wks.ChartObjects.Count > 0 Then wks.ChartObjects.Delete
Set co = ActiveSheet.ChartObjects.Add(50, 40, 200, 200)
With co.Chart
Set s1 = .SeriesCollection.NewSeries
s1.Values = Array(20, 30, 40, 50, 30, 10)
Set s2 = .SeriesCollection.NewSeries
s2.XValues = Array(1, 2, 3, 4, 5, 6)
.ClearToMatchStyle
.ChartStyle = 238
.HasTitle = True
.ChartTitle.Characters.Text = "Häufigkeiten"
.Legend.Delete
End With
End Sub
Nochmals danke und herzliche Grüße
Rolf