создание диаграмм с помощью скрипта vba

Question

Я пишу скрипт для создания диаграмм, по одному на строку в моей таблице. Идея состоит в том, чтобы получить линейный график, чтобы показать историю.

таблица выглядит следующим образом:

date modem capacity used 
16/01/2017 PUT  20gb 54% 20/01/2017 73% 21/01/2017 80% 
16/01/2017 PATITIFA 20gb 73% 20/01/2017 79% 21/01/2017 90% 
16/01/2017 HAWAIKI 40gb 44% 20/01/2017 55% 21/01/2017 70% 
16/01/2017 NUI  60gb 48% 20/01/2017 61% 21/01/2017 80% 
16/01/2017 ITI  20gb 75% 20/01/2017 84% 21/01/2017 90% 
16/01/2017 huawei 20gb 37% 20/01/2017 45% 21/01/2017 60% 

мой скрипт, который VBA пытается создать таблицы здесь:

Sub addchart() 
Dim chartPut, chartPatitifa, chartHawaiki, chartNui, chartIti, chartHuawei As Chart 
Dim iRow, iCol As Long 
Dim date1, date2, date3, date4, date5, date6 As String 
Dim conso1, conso2, conso3, conso4, conso5, conso6 As String 
Dim forfait As String 
Dim modem As String 


iRow = 2 
iCol = 1 


Do Until IsEmpty(Cells(iRow, 1)) 
    date1 = Cells(iRow, 1).Value 
    modem = Cells(iRow, 2).Value 
    forfait = Cells(iRow, 3).Value 
    conso1 = Cells(iRow, 4).Value 
    date2 = Cells(iRow, 5).Value 
    conso2 = Cells(iRow, 6).Value 
    date3 = Cells(iRow, 7).Value 
    conso3 = Cells(iRow, 8).Value 
    date4 = Cells(iRow, 9).Value 
    conso4 = Cells(iRow, 10).Value 
    date5 = Cells(iRow, 11).Value 
    conso5 = Cells(iRow, 12).Value 
    date6 = Cells(iRow, 13).Value 
    conso6 = Cells(iRow, 14).Value 

    Set chartPut = Charts.Add 
    With chartPut 
     .SetSourceData Source:=Range("STATS!$A$2:$F$2") 
     .SeriesCollection(1).Name = modem 
     'conso values 
     .SeriesCollection(1).Values = "conso1; conso2; conso3; conso4; conso5; conso6" 
     'date values 
     .SeriesCollection(1).XValues = "date1; date2; date3; date4; date5; date6 " 

    End With 

Loop 



End Sub 

Дело в том, что я не могу получить «Консо» и "даты", которые должны приниматься в качестве значений данных в таблице .... любые идеи?

Answer 1

Для установки постоянных значений для кривой используйте массив.

.SeriesCollection(1).Values = Array(conso1, conso2, conso3, conso4, conso5, conso6) 

.SeriesCollection(1).XValues = Array(date1, date2, date3, date4, date5, date6) 

EDIT

Так что вы хотите, чтобы ваши ряды, чтобы обратиться к этим ячейкам динамически, и проблема вы столкнулись в том, что вы не знаете, априорно последнюю строку диапазона. Все, что вам нужно, это установить диапазон и подавать его в серию диаграмм.

Sub addConsoCharts() 
    Dim iRow As Long, modem As String, dates As Range, consos As Range 

    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    On Error GoTo Finished 
    With Sheets("Sheet1") ' <-- Set to the name of your worksheet 
     iRow = 2 
     Do Until IsEmpty(.Cells(iRow, 1)) 
      modem = .Cells(iRow, 2).Value 
      Set dates = Union(.Cells(iRow, 1), .Cells(iRow, 5), .Cells(iRow, 7), .Cells(iRow, 9), .Cells(iRow, 11), .Cells(iRow, 13)) 
      Set consos = Union(.Cells(iRow, 4), .Cells(iRow, 6), .Cells(iRow, 8), .Cells(iRow, 10), .Cells(iRow, 12), .Cells(iRow, 14)) 
      With ThisWorkbook.Charts.Add 
       .ChartArea.ClearContents 
       .Name = "Conso_" & iRow 
       With .SeriesCollection.NewSeries 
        .Name = modem 
        .XValues = dates 
        .Values = consos 
       End With 
      .SeriesCollection.NewSeries.Values = Range("STATS!$A$2:$F$2") 

      End With 
      iRow = iRow + 1 
      Loop 
    End With 
Finished: 
    Application.ScreenUpdating = True 
    Application.EnableEvents = True 
End Sub 

Sub CleanupConsosCharts() ' <-- to delete all these charts if needed 
    Application.DisplayAlerts = False 
    Dim ch As Chart 
    For Each ch In ThisWorkbook.Charts 
     If ch.Name Like "Conso_*" Then ch.Delete 
    Next 
    Application.DisplayAlerts = True 
End Sub 

p.s. Я добавил вам процедуру очистки, вам может понадобиться удалить эти диаграммы, и, поскольку их много, будет утомительно удалить их вручную.