使用 VBA 在动态公共日期行上绘制图表

Question

我想绘制下面的数据集。

由于每个日期都不同，我创建了一个通用的所有日期行，并尝试在同一x轴上绘制具有不同日期范围的多折线图。

下面是我正在尝试的代码（不完整）

sub plot_chart()

    Range("2:2,3:3,5:5,8:8,11:11,14:14").Select
    ActiveSheet.Shapes.AddChart2(227, xlLineStacked).Select
    ActiveChart.SetSourceData Source:=Range( _
        "Sheet3!$2:$2,Sheet3!$3:$3,Sheet3!$5:$5,Sheet3!$8:$8,Sheet3!$11:$11,Sheet3!$14:$14" _
        )
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 230
    'ActiveChart.FullSeriesCollectioin(1).ApplyDataLables

End sub

上面的代码工作没有任何错误，但该图表不是我想要的。

我希望每一行显示从相应日期（date1，date2，，，）起点到终点的数据，对于缺失值部分，只需忽略它即可。

Answer 1

• 创建图表之前更改表格布局

Option Explicit

Sub Demo()
    Dim i As Long, j As Long, iCol As Long, ColCnt As Long
    Dim arrData, arrData2, rngData As Range, allDateRng As Range
    Dim arrRes, iR As Long, oSht As Worksheet, xRng As Range
    Dim LastRow As Long, aRow, iMin As Long, iMax As Long
    aRow = Array(2, 5, 8, 11) ' row# of table blocks
    ' create a copy
    Sheets(1).Copy After:=Sheets(Sheets.Count)
    Set oSht = ActiveSheet
    ' load all data into an array
    Set allDateRng = oSht.Range("A" & aRow(0)).CurrentRegion
    arrData = allDateRng.Value
    ColCnt = UBound(arrData, 2)
    Set xRng = allDateRng.Resize(1, ColCnt - 1).Offset(, 1)
    ' get the min date
    iMin = Application.Min(oSht.Rows(aRow(0)))
    ' loop through data blocks, transform table
    For i = 1 To UBound(aRow)
        Set rngData = oSht.Range("A" & aRow(i)).CurrentRegion
        arrData2 = rngData.Value
        ReDim arrRes(1, 1 To ColCnt)
        arrRes(0, 1) = arrData2(1, 1)
        arrRes(1, 1) = arrData2(2, 1)
        For j = 2 To UBound(arrData2, 2)
            iCol = CLng(arrData2(1, j)) - iMin + 2
            arrRes(0, iCol) = arrData2(1, j)
            arrRes(1, iCol) = arrData2(2, j)
        Next
        rngData.Resize(, ColCnt).Value = arrRes
    Next
    
    Dim oShp As Shape, oCht As Chart, oSer As Series, serRng As Range
    ' add a chart
    Set oShp = ActiveSheet.Shapes.AddChart2(332, xlLineMarkers)
    ' relocate chart , modify as needed
    oShp.Top = oSht.Range("A15").Top: oShp.Left = 0
    Set oCht = oShp.Chart
    ' add the first series (All Data)
    oCht.SetSourceData allDateRng
    ' add other series
    For i = 1 To UBound(aRow)
        Set oSer = oCht.SeriesCollection.NewSeries
        oSer.Name = "='" & oSht.Name & "'!" & oSht.Range("A" & aRow(i)).Address
        Set serRng = oSht.Range("A" & aRow(i)).Offset(1, 1).Resize(, ColCnt - 1)
        Set serRng = xRng.Offset(aRow(i) - aRow(0) + 1)
        oSer.Values = "='" & oSht.Name & "'!" & serRng.Address
        oSer.XValues = xRng
    Next
End Sub