VBA Проблемы с диаграммами

Question

Я добавил два кода, которые я нашел в этих сообщениях, но теперь графики не отображают данные в диапазоне («B2: C2»). Я только начинаю узнавать, как писать так, чтобы медведь был мной. Может кто-нибудь помочь?

Спасибо заранее

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 цикла. Что-то вроде этого:

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