添加系列到图表

时间:2017-06-03 01:01:06

标签: excel excel-vba series excel-charts vba

我使用Holebase进行工作,如果excel知道如何区分新系列的开头,这对我来说非常有用,因为我们到目前为止只有通过在系列之间产生差距来显示一个系列。 所以我试图操纵的宏是从这里开始的,并且已经进行了调整,因为前一个适合的目的略有不同。

我想要的是:每当我在A列上找到一个新的BH时,就会绘制一个与C列和D列(分别为x和y)的值直到A列上的下一个BH的不同系列。

我设法解决了这个问题。因此宏首先删除图表中的所有系列,第二次每次在A列上有新的值/文本时,它会显示C(X)列和D(Y)列上显示的数据。

不,我只有一个问题需要解决。 x范围需要有一个最小日期,因为excel默认总是采用1900

Sub MakeCharts()
Dim sh As Worksheet
Dim rAllData As Range
Dim rChartData As Range
Dim cl As Range
Dim rwStart As Long, rwCnt As Long
Dim s As Series
Dim SourceRangeColor As Long

Set sh = ActiveSheet

sh.ChartObjects(1).Activate

'Set chrt = sh.ChartObjects(1)

For Each s In ActiveChart.SeriesCollection
  s.Delete
Next s

With sh
    ' Get reference to all data
    Set rAllData = .Range(.[A1], .[A1].End(xlDown)).Resize(, 4)
    ' Get reference to first cell in data range
    rwStart = 2
    Set cl = rAllData.Cells(rwStart, 1)

    Do While cl <> ""

        'Capture the first cell in the source range then trap the color
        Set SourceRange = rAllData.Cells(rwStart, 5)
        SourceRangeColor = SourceRange.Interior.Color

        ' cl points to first cell in a station data set
        ' Count rows in current data set
        rwCnt = Application.WorksheetFunction. _
           CountIfs(rAllData.Columns(1), cl.Value)

        ' Get reference to current data set range
        Set rChartData = rAllData.Cells(rwStart, 1).Resize(rwCnt, 4)

        'ActiveChart.SeriesCollection.Add _
        'Source:=rChartData

    With ActiveChart.SeriesCollection.NewSeries

        .ChartType = xlXYScatterLines

        .XValues = rChartData.Offset(, 2).Resize(, 1)

        .Values = rChartData.Offset(, 3).Resize(, 1)

        .Name = rAllData.Cells(rwStart, 1)

        .MarkerBackgroundColor = SourceRangeColor
        .MarkerForegroundColor = SourceRangeColor
        '.Format.Line.ForeColor.RGB = SourceRangeColor (line colour for workbook 2007-2010)
        '.Format.Line.BackColor.RGB = SourceRangeColor  (line colour for workbook 2007-2010)
        '.Format.Fill.ForeColor.RGB = SourceRangeColor  (line colour for workbook 2007-2010)

        .Interior.Color = SourceRangeColor
        .Border.Color = SourceRangeColor

        '.Axes(xlCategory, xlPrimary).CategoryType = xlTimeScale
        '.Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "dd-mm-yyyy"
        '.Axes(xlCategory, xlPrimary).MinimumScale = Application.Min.Range("C:C")
        '.Axes(xlCategory, xlPrimary).MaximumScale = Application.Max.Range("C:C")


                ' Get next data set
        rwStart = rwStart + rwCnt
        Set cl = rAllData.Cells(rwStart, 1)
    End With
    Loop


End With

End Sub

由于

enter image description here

0 个答案:

没有答案