VBA-添加系列取决于A列中的价值是否已更改

Question

我有一些看起来像这样的数据...

Area Name   x value y value sum mia3ever    proportion  Postcode
London  0.71926819  0.194887721 257 12% TW13
London  0.249070388 0.678239918 153 7%  TW13
London  0.895600342 0.50096083  102 5%  TW13
London  0.226127681 0.286161753 32  2%  TW13
London  0.063482651 0.997888216 56  3%  TW13
London  0.559486828 0.3184387   44  2%  TW13
London  0.505436766 0.627708014 32  2%  TW13
London  0.51053101  0.90729441  21  1%  TW13
London  0.793446485 0.429025666 13  1%  TW13
London  0.984280399 0.961682652 7   0%  TW13
Swindon 0.40981356  0.89159907  321 15% SN3
Swindon 0.476922958 0.877030395 221 11% SN3
Swindon 0.054196462 0.630455049 128 6%  SN3
Swindon 0.50651053  0.250699362 194 9%  SN3
Swindon 0.765687797 0.291577129 126 6%  SN3
Swindon 0.349227537 0.642574308 23  1%  SN3
Birmingham  0.061425423 0.307267677 176 8%  B1
Birmingham  0.055064149 0.00827374  111 5%  B1
Birmingham  0.044373053 0.978586414 66  3%  B1 

到目前为止，我的代码看起来像这样...

Option Explicit
Sub MakeChart()
Dim LastRow As Long
Dim LastColumn As Long
Dim aRng As Range
Dim seriescheck As Range
Set aRng = Selection.CurrentRegion
    LastRow = aRng.End(xlDown).Row
    LastColumn = aRng.End(xlToRight).Column
        msg = MsgBox("Last Row: " & LastRow & ", Last Column: " & LastColumn)
Set aRng = aRng.offset(1, 0).Resize(aRng.Rows.Count - 1)
Set seriescheck = aRng.offset(1, 0).Resize(aRng.Rows.Count - 1, 1)
seriescheck.Select
For Each cell In seriescheck
If cell.value <> cell.offset(1, 0).value Then
    MsgBox ("Row: " & cell.Row)
End If
Next
End Sub

我不确定您是否可以看到图像，因为我是新用户，但无论如何我都会描述它。它是邮政编码数据，A列具有区域名称（例如伦敦，史温顿，伯明翰）。我需要此代码将每个区域作为新系列添加到散点图。

到目前为止，我已经弄清楚了如何识别每个系列的结尾，但是我现在需要将它们添加到图表对象中，并在到达最后一行时将代码结束。我是VBA的新手，并尝试与之掌握，任何人都可以帮忙吗？

预先感谢。

Answer 1

我已经稍微编辑了您的代码，并添加了将您的数据添加到图表中的代码。

我不确定您要绘制的数据的哪一部分，所以我假设您想做X-Val/Y-VAL列的散点图，而Areaname作为串联名称。

您需要在工作表中添加空白散点图，并更新下面的" set cht = ...."行以引用此。

希望这很有帮助，祝你好运。

Option Explicit
Sub MakeChart()
Dim LastRow As Long
Dim LastColumn As Long
Dim aRng As Range
Dim seriescheck As Range
    Set aRng = Selection.CurrentRegion
    Set aRng = aRng.Offset(1, 0).Resize(aRng.Rows.Count - 1)
    Set seriescheck = aRng.Resize(aRng.Rows.Count, 1)
    Dim cht As Chart, seriesName As String, seriesData As Range
    'Set reference to chart: need to update this to match the location and name of the chart you create
    Set cht = Sheet1.ChartObjects("Chart 1").Chart
    'Clear any series currently on the chart
    Call ClearChartSeries(cht)
    Dim cell As Range
    Dim startRow As Long, endRow As Long, cnt As Long
    'Loop through, find series data and add to chart
    startRow = 1: cnt = 0
    For Each cell In seriescheck
        cnt = cnt + 1
        If cell.Value <> cell.Offset(1, 0).Value Then
            endRow = startRow + cnt - 1
            Set seriesData = aRng.Offset(startRow - 1, 1).Resize(endRow - startRow + 1, 2)
            seriesName = cell.Value
            Call AddChartSeries(cht, seriesName, seriesData)
            startRow = endRow + 1: cnt = 0
        End If
    Next
End Sub

'Expecting two columns: date and index values
'Assumes x and y values are next to each other
Public Function AddChartSeries(cht As Chart, seriesName As String, rngData As Range)
    'Set data references
    Dim xAddress As String, yAddress As String
    xAddress = rngData.Parent.Name & "!" & rngData.Resize(rngData.Rows.Count, 1).Address
    yAddress = rngData.Parent.Name & "!" & rngData.Resize(rngData.Rows.Count, 1).Offset(0, 1).Address
    'Add a new series to the chart with these data references
    Dim seriesCnt As Long
    seriesCnt = cht.SeriesCollection.Count
    cht.SeriesCollection.NewSeries
    cht.SeriesCollection(seriesCnt + 1).Name = seriesName
    cht.SeriesCollection(seriesCnt + 1).XValues = xAddress
    cht.SeriesCollection(seriesCnt + 1).Values = yAddress
End Function
'Removes all series from a chart
'Used to clear charts before adding new data
Public Sub ClearChartSeries(cht As Chart)
    Dim s As Series
    'Flush all existing series
    For Each s In cht.SeriesCollection
        s.Delete
    Next s
End Sub