Erstellen von Diagrammen mit VBA-Skript

Question

Ich schreibe ein Skript zum Erstellen von Diagrammen, eines pro Zeile in meiner Tabelle. Die Idee ist, ein Liniendiagramm zu erhalten, um den Verlauf anzuzeigen.

die Tabelle sieht wie folgt aus:

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% 

mein VBA-Skript, das die Tabellen zu erstellen versucht, ist hier:

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 

Die Sache ist, ich nicht die „conso“ bekommen und "Datum" -Werte, die als Datenwerte in die Tabelle übernommen werden sollen. irgendwelche Ideen?

Answer 1

Verwenden Sie ein Array, um konstante Werte für die Kurve festzulegen.

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

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

EDIT

So möchten Sie Ihre Serie dynamisch an diese Zellen beziehen, und das Problem, das Sie konfrontiert sind, ist, dass man a priori die letzte Zeile des Bereichs nicht wissen. Alles, was Sie brauchen, ist, Ihren Bereich festzulegen und ihn der Serie des Charts zuzuführen.

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. Ich habe Ihnen eine Aufräumroutine hinzugefügt, die Sie möglicherweise benötigen, um diese Diagramme zu entfernen, und da es viele sind, wird es mühsam sein, sie von Hand zu entfernen.