Как создать составную диаграмму в VBA с несколькими сериями?

Question

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

Мне нужно создать диаграмму в виде выше, и я написал код ниже, однако кажется, что макрос не видит 4-й серии. Другой вариант - установить rng как Sd1: SH "& CountT + 1 и игнорировать rng2, однако этот параметр использует значения идентификатора плюс первый ряд в качестве значений оси X. Может кто-нибудь сказать, пожалуйста, что я делаю неправильно ?

Sub GraphPs()

    Dim CountT As Integer
    Dim cht As Chart


    Range("sd1:sh200").Select
    Selection.ClearContents
    CountB = 0
    CountC = 0
    CountD = 0
    CountT = Range("B" & Rows.Count).End(xlUp).Row - 1

    Set RngBegin = Range("c2:c" & CountT + 1)
    Set RngEnd = Range("d2:d" & CountT + 1)

    Mindate = Application.WorksheetFunction.Min(RngBeginDate)

    For i = 1 To CountT

'calculate series 2, 3 and 4. Series 1 is the values of the input in column C

        Date1 = Cells(i + 1, 3)
        Date2 = Cells(i + 1, 4)

        If Date1 = Empty And Date2 = Empty Then
            NumberD = Empty
        End If

        If Date1 <> Empty And Date2 <> Empty Then
            NumberD = Date2 - Date1
        End If

        If Date1 <> Empty And Date2 = Empty Then
            NumberD = Date - Date1
        End If

        If NumberD >= 365 Then
            Cells(i + 1, 500) = NumberD
            Cells(i + 1, 501) = 0
            Cells(i + 1, 502) = 0
            CountB = CountB + 1
        End If

        If NumberD >= 365 / 2 And NumberD < 365 Then
            Cells(i + 1, 500) = 0
            Cells(i + 1, 501) = NumberD
            Cells(i + 1, 502) = 0
            CountC = CountC + 1
        End If

        If NumberD < 365 / 2 Then
            Cells(i + 1, 500) = 0
            Cells(i + 1, 501) = 0
            Cells(i + 1, 502) = NumberD
            CountD = CountD + 1
        End If

        Cells(i + 1, 498) = Cells(i + 1, 2)
        Cells(i + 1, 499) = Cells(i + 1, 3)

    Next

'Delete old chart

    Application.ScreenUpdating = False
    On Error Resume Next
    ActiveSheet.ChartObjects.Delete
    On Error GoTo 0
    Application.ScreenUpdating = True

    'Create graph

    Set cht = Sheets("Sheet1").ChartObjects.Add(38, 38, 400, 400).Chart
    Set Rng = Range("Se1:SH" & CountT + 1)
    Set Rng2 = Range("Sd2:sd" & CountT + 1)

    'Writes legend
    Cells(1, 498) = " "
    Cells(1, 499) = "A"
    Cells(1, 500) = "B"
    Cells(1, 501) = "C"
    Cells(1, 502) = "D"

    With cht
        .ChartType = xlBarStacked
        .HasTitle = True
        .HasLegend = True
        .SetSourceData Source:=Rng, PlotBy:=xlColumns



    With Sheets("Sheet1").ChartObjects(1)
        .Left = Range("b38").Left
        .Top = Range("b" & CountT + 5).Top
        .Width = 900
    End With``

    .Axes(xlValue, xlPrimary).MinimumScale = Mindate

    .Axes(xlValue).TickLabels.NumberFormat = "mm-dd-yyyy"
    .Axes(xlValue).MajorUnit = 365.25
    .Axes(xlValue, xlPrimary).HasMajorGridlines = True
    cht.ChartGroups(1).GapWidth = 500
    cht.ChartGroups(1).Overlap = 0

    .SeriesCollection(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 255)
        .Transparency = 0
        .Solid
    End With

    If CountB <> 0 Then
        .SeriesCollection(2).Select
        With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(177, 160, 199)
        End With
    End If

    If CountC <> 0 Then
        .SeriesCollection(3).Select
         With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 192, 0)
        End With
    End If

 'here is the error in the code

     If CountD <> 0 Then
        .SeriesCollection(4).Select
        With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(196, 215, 155)
        End With
     End If

    'Format chart
    With .ChartTitle
        .Characters.Font.Bold = True
        .Characters.Font.Size = 18
        .Characters.Font.Color = RGB(0, 0, 0)
        .Text = "POR"
    End With

    With .PlotArea.Border
        .LineStyle = xlContinuous
        .Weight = xlThin
        .Color = RGB(0, 0, 0)
    End With

    ' add chart area border
    With .ChartArea.Border
        .LineStyle = xlDot
        .Weight = xlThin
        .Color = RGB(0, 0, 0)
    End With
    End With

Range("a37:a37").Select

End Sub