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

编程问答 2022-04-21

问题描述

我需要一些帮助来编写一些生成折线图的 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 = ActiveSheet 'Sheets("Breather L551")
 Set wsG = wsB.Next    '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 提供新范围（如果存在）。但是没有类似的数据来测试，稍微复杂一些。

excelexcelgraphgraphgraphrangerangespcvba