Excel макрос для создания линейной диаграммы, исключая столбцы между

Question

Я хочу создать линейную диаграмму в макросе excel. У меня есть таблица в excel.

Первой линия Диаграмма содержит диапазон значений от сот А и В. Второй линии диаграммы содержит диапазон значений от сот А и С. Третьей линии Диаграммы содержит диапазон значений от ячейки А и D.

ActiveSheet.Shapes.AddChart.Select 
ActiveChart.SetSourceData Source:=Range("A1:D3") 
ActiveChart.ApplyDataLabels 
ActiveChart.ChartType = xlLine 

Выше кода выводится только одна линейная диаграмма для диапазонов от A1 до D4.

Answer 1

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

Sub Macro1() 
    Range("A1:D2").Select 
    ActiveSheet.Shapes.AddChart.Select 
    ActiveChart.ChartType = xlLine 
    ActiveChart.SetSourceData Source:=Range("Sheet1!$A$1:$D$2") 
    ActiveChart.PlotArea.Select 
    ActiveChart.SeriesCollection.NewSeries 
    ActiveChart.SeriesCollection(2).Name = "=Sheet1!$A$3" 
    ActiveChart.SeriesCollection(2).Values = "=Sheet1!$B$3:$D$3" 
End Sub 

---

---

Вот как я хотел бы сделать это без использования выберите

Sub createChart() 
    Dim wks As Worksheet 
    Set wks = Worksheets("Sheet1") 

    Dim chrt As Chart 
    Set chrt = wks.Shapes.AddChart.Chart 

    With chrt 
     .ChartType = xlLine 
     .SetSourceData Source:=Range("Sheet1!$A$1:$D$2") 
     .SeriesCollection.NewSeries 
     .SeriesCollection(2).Name = "=Sheet1!$A$3" 
     .SeriesCollection(2).Values = "=Sheet1!$B$3:$D$3" 
    End With 
End Sub 

---

Looping

Sub createChartWithLoop() 
    Dim wks As Worksheet 
    Set wks = Worksheets("Sheet1") 

    Dim chrt As Chart 
    Set chrt = wks.Shapes.AddChart.Chart 

    Dim chartRange As Range 
    Set chartRange = wks.Range("A1:A4") 

    With chrt 
     .ChartType = xlLine 
     .SetSourceData Source:=Range(wks.Range("A" & chartRange.Row & ":D" & chartRange.Row).Address) 

     For i = chartRange.Row + 1 To chartRange.Rows.Count 
      .SeriesCollection.NewSeries 
      .SeriesCollection(i).Name = wks.Cells(i, 1) 
      .SeriesCollection(i).Values = wks.Range("B" & i & ":D" & i) 
     Next i 
    End With 
End Sub 

---

EDIT - Создание различных диаграмм из каждой строки данных

Sub createDifferentCharts() 
    Dim wks As Worksheet 
    Set wks = Worksheets("Sheet1") 

    Dim chartRange As Range 
    Set chartRange = wks.Range("A1:A4") 

    For i = chartRange.Row To chartRange.Rows.Count 
     With wks.Shapes.AddChart.Chart 
      .ChartType = xlLine 
      .SetSourceData Source:=Range(wks.Range("A" & i & ":D" & i).Address) 
      .Parent.Left = 20 + i * 50 
      .Parent.Top = 40 + i * 50 
     End With 
    Next i 
End Sub 

Результаты:

---

Создание различных диаграмм для каждого столбца данных с колонки А представляет метки:

Sub createDifferentCharts() 
    Dim wks As Worksheet 
    Set wks = Worksheets("Sheet1") 

    Dim chartRange As Range 
    Set chartRange = wks.Range("A1:D4") 

    For col = chartRange.Column + 1 To chartRange.Columns.Count 
     With wks.Shapes.AddChart.Chart 
      .ChartType = xlLine 
      .SetSourceData Source:=Range(wks.Cells(1, 1).Address) 
      .SetSourceData Source:=wks.Range("A1:A4," & Range(Cells(chartRange.Row, col), Cells(chartRange.Rows.Count, col)).Address) 
      .Parent.Left = col * 30 
      .Parent.Top = col * 30 
     End With 
    Next col 
End Sub