VBA - 取決於列中的值是否已更改添加系列

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