需要创建一个SPC图表,该图表使用新数据进行更新,并使用最后30个单元格作为范围



我需要一些帮助来编写一些生成折线图的VBA代码。当添加新数据时,图表需要更新,我还需要显示的数据范围是最后30个数据单元格。我不得不将其添加到现有工作簿中,并且已经能够编写VBA,在图表上显示现有数据。

我已经创建了

Sub Chartspc()
Dim chrt As ChartObject
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim r4 As Range
Set r1 = Sheets("Breather L551").Range("J231:J261")
Set r2 = Sheets("Breather L551").Range("N231:N261")
Set r3 = Sheets("Breather L551").Range("R231:R261")
Set r4 = Sheets("Breather L551").Range("V231:V261")

Set chrt = Sheets("GRAPHTEST").ChartObjects.Add(Left:=0, Width:=600, Top:=0, Height:=300)
chrt.Chart.SetSourceData Source:=Union(r1, r2, r3, r4)
With chrt
.Chart.ChartType = xlLine
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "L551"
.Chart.SetElement (msoElementLegendRight)
.Chart.SeriesCollection(1).Name = "LrA CP"
.Chart.SeriesCollection(2).Name = "LrB CP"
.Chart.SeriesCollection(3).Name = "LrC CP"
.Chart.SeriesCollection(4).Name = "LrD CP"
End With
End Sub

更详细地说,我希望能够从我拥有的数据的底部30个单元格创建一个图形。然后,我希望在图上表示新数据,并删除或不表示在图上的30个单元格范围之外的旧数据;这将是底部单元格和上面的29个单元格,然后当添加新数据时,所有单元格都会向下调整一个单元格。

请测试下一个代码。它将创建一个包含最后30行的系列范围的图表(根据J:J列最后一行计算(:

Sub Chartspc()
Dim wsB As Worksheet, wsG As Worksheet, lastR As Long, firstR As Long
Dim chrt As ChartObject, r1 As Range, r2 As Range, r3 As Range, r4 As Range
Set wsB = Sheets("Breather L551")
Set wsG = Sheets("GRAPHTEST")
lastR = wsB.Range("J" & wsB.rows.count).End(xlUp).row 'J
If lastR > 31 Then
firstR = lastR - 29
Else
firstR = 2
End If
Set r1 = wsB.Range("J" & firstR & ":" & "J" & lastR)
Set r2 = wsB.Range("N" & firstR & ":" & "N" & lastR)
Set r3 = wsB.Range("R" & firstR & ":" & "R" & lastR)
Set r4 = wsB.Range("V" & firstR & ":" & "V" & lastR)
On Error Resume Next
wsG.ChartObjects("Chart30Rows").Delete 'delete the chart if it exists
On Error GoTo 0

Set chrt = wsG.ChartObjects.Add(left:=0, width:=600, top:=0, height:=300)
chrt.Name = "Chart30Rows"
chrt.Chart.SetSourceData Source:=Union(r1, r2, r3, r4)
With chrt
.Chart.ChartType = xlLine
.Chart.HasTitle = True
.Chart.chartTitle.Text = "L551"
.Chart.SetElement (msoElementLegendRight)
.Chart.SeriesCollection(1).Name = "LrA CP"
.Chart.SeriesCollection(2).Name = "LrB CP"
.Chart.SeriesCollection(3).Name = "LrC CP"
.Chart.SeriesCollection(4).Name = "LrD CP"
End With
End Sub

请测试并发送一些反馈。我无法测试它…

该代码可以用于搜索图表是否已经存在,如果不存在,则创建一个新的图表,或者如果存在,则仅向SeriesCollection提供新的范围。但由于没有类似的数据来测试它,它有点复杂。

最新更新