AW: Laufzeitfehler
01.10.2016 07:31:56
fcs
Hallo Michq,
Hauptproblem:
Beim Setzen der Zellbereiche für rng1 und rng2 hast du die Zeilen-Numern im Cells-Teile nicht korrekt angepasst.
Nebenprobleme:
Für die Datenreihen müssen auch die X-Achsenwerte jeweils zugewiesen werden.
Und der Name der Reihen ebenfalls. Hier sind die im Diagram als Text vorgegebenen Werte verwirrend.
Das Makro kann dann wie folgt aussehen - getestet unter Office 365 (2016).
Gruß
Franz
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "A1" Then
Dim KW As Long, rng As Range
Dim KW1 As Long, rng1 As Range
Dim KW2 As Long, rng2 As Range
Dim intS As Integer
Dim objChart As Chart
KW = Replace(Target, "KW", "") * 1
KW1 = KW
KW2 = KW
With Worksheets("PLANT DATA")
Set rng = .Range(.Cells(3, 4), .Cells(3, KW + 3))
Set rng1 = .Range(.Cells(11, 4), .Cells(11, KW1 + 3))
Set rng2 = .Range(.Cells(19, 4), .Cells(19, KW2 + 3))
End With
Set objChart = ActiveSheet.ChartObjects("Chart 2").Chart
With objChart
For intS = 1 To 4
With .SeriesCollection(intS)
.XValues = "='PLANT DATA'!" & rng.Offset(-1, 0).Address
.Values = "='PLANT DATA'!" & rng.Offset(intS - 1, 0).Address
.Name = "='PLANT DATA'!" & rng.Offset(intS - 1, -1).Range("A1").Address
End With
Next
End With
Set objChart = ActiveSheet.ChartObjects("Chart 3").Chart
With objChart
For intS = 1 To 4
With .SeriesCollection(intS)
.XValues = "='PLANT DATA'!" & rng1.Offset(-1, 0).Address
.Values = "='PLANT DATA'!" & rng1.Offset(intS - 1, 0).Address
.Name = "='PLANT DATA'!" & rng1.Offset(intS - 1, -1).Range("A1").Address
End With
Next
End With
Set objChart = ActiveSheet.ChartObjects("Chart 4").Chart
With objChart
For intS = 1 To 4
With .SeriesCollection(intS)
.XValues = "='PLANT DATA'!" & rng2.Offset(-1, 0).Address
.Values = "='PLANT DATA'!" & rng2.Offset(intS - 1, 0).Address
.Name = "='PLANT DATA'!" & rng2.Offset(intS - 1, -1).Range("A1").Address
End With
Next
End With
End If
End Sub
In weiter komprimierter Form:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "A1" Then
Dim intC As Integer, KW(1 To 3) As Long, rng(1 To 3) As Range
Dim intS As Integer
Dim objChart As Chart
KW(1) = Val(Replace(Target, "KW", ""))
KW(2) = KW(1)
KW(3) = KW(1)
With Worksheets("PLANT DATA")
Set rng(1) = .Range(.Cells(3, 4), .Cells(3, KW(1) + 3))
Set rng(2) = .Range(.Cells(11, 4), .Cells(11, KW(2) + 3))
Set rng(3) = .Range(.Cells(19, 4), .Cells(19, KW(3) + 3))
End With
For intC = 1 To 3
Set objChart = ActiveSheet.ChartObjects("Chart " & Format(intC + 1, "0")).Chart
With objChart
For intS = 1 To 4
With .SeriesCollection(intS)
.XValues = "='PLANT DATA'!" & rng(intC).Offset(-1, 0).Address
.Values = "='PLANT DATA'!" & rng(intC).Offset(intS - 1, 0).Address
.Name = "='PLANT DATA'!" & rng(intC).Offset(intS - 1, -1).Range("A1").Address
End With
Next
End With
Next
End If
End Sub