VBA图表问题

我组合了在这些post中find的两个代码，但是现在图表没有显示Range（“B2：C2”）中的数据。 我刚刚开始学习如何写macros，所以忍受着我。 有人可以帮忙吗？

先谢谢你

Sub test() Range("A2").Select Do Until IsEmpty(ActiveCell) Dim ws As Worksheet Dim rng As Range Set ws = Sheets("Sheet1") Set rng = ws.Range("B2:C2").Offset(Row, 0) ActiveSheet.Shapes.AddChart.Select ActiveChart.SetSourceData Source:=Range(ws.Name & "!" & rng.Address) ActiveChart.ChartType = xlLineMarkers ActiveChart.PlotArea.Select ActiveChart.SeriesCollection(1).XValues = "='Sheet1'!$B$2:$C$2" ActiveChart.SeriesCollection(1).Name = ws.Range("A2").Offset(Row, 0).Value ActiveChart.Location Where:=xlLocationAsNewSheet ws.Select ActiveCell.Offset(1, 0).Select Loop Set ws = Nothing Set rng = Nothing End Sub 

Answer 1

您可以在For / Next循环中build立具有数据的最后一行并使用该行号。 像这样的东西：

 Sub test() Dim Row As Integer, lastRow As Integer Dim ws As Worksheet Dim rng As Range Set ws = Sheets("Sheet1") lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row - 1 Debug.Print lastRow For Row = 1 To lastRow Set rng = ws.Range("B1:C1").Offset(Row, 0) ActiveSheet.Shapes.AddChart.Select ActiveChart.SetSourceData Source:=Range(ws.Name & "!" & rng.Address) ActiveChart.ChartType = xlLineMarkers ActiveChart.PlotArea.Select ActiveChart.SeriesCollection(1).XValues = "='Sheet1'!$B$1:$C$1" ActiveChart.SeriesCollection(1).Name = ws.Range("A1").Offset(Row, 0).Value ActiveChart.Location Where:=xlLocationAsNewSheet ws.Select Next Row Set ws = Nothing Set rng = Nothing End Sub 

Answer 2

其他方式。 避免使用.Select ， .ActiveChart等…

 Sub Sample() Dim ws As Worksheet Dim rng As Range Dim lRow As Long, i As Long Dim ObjChrt As Object Dim Chrt As Chart Set ws = Sheets("Sheet1") With ws '~~> Find the last row lRow = .Range("B" & .Rows.Count).End(xlUp).Row '~~> Loop through the values For i = 2 To lRow Set rng = .Range("B" & i & ":C" & i) '~~> Work with Chart Objects Set ObjChrt = .Shapes.AddChart Set Chrt = ObjChrt.Chart '~~> Assign relevant values With Chrt .SetSourceData Source:=ws.Range(rng.Address) .ChartType = xlLineMarkers .SeriesCollection(1).XValues = "='" & ws.Name & "'!$B$" & i & ":$C$" & i .SeriesCollection(1).Name = ws.Range("A" & i).Value .Location Where:=xlLocationAsNewSheet End With Next i End With Set ws = Nothing Set rng = Nothing End Sub