Question

我对VBA很陌生，所以我希望能更全面地解释你为解决这个小问题所采取的措施。

我的任务是创建一个简单的VBA程序，该程序接受已经排序的数据集（我了解它然后使用VBA程序按照字母顺序对特定列的值进行排序）并执行以下两项操作用它：

使用它（在该工作表内或单独的工作表中）绘制散点图

和

动态创建具有该散点图的系列（意味着散点图基于特定列的值具有系列）。我不知道我需要多少系列但我知道，因为它已经排序，定义该行中数据类型的列将按字母顺序排列（我假设VBA程序可以首先创建一个具有第一行名称的系列然后不会创建更多系列，直到它在该列中找到不同的名称，直到完成数据的图形化为止）

简单的3列表的示例如下所示：

系列名称___X VALUE_____Y VALUE

一个__________________ 1 ___________ 1

一个__________________ 2 ___________ 2

一个__________________ 3 ___________ 3

一个__________________ 4 ___________ 4

乙__________________ 5 ___________ 5

乙__________________ 6 ___________ 6

乙__________________ 7 ___________ 7

Ç__________________ 8 ___________ 8

Ç__________________ 9 ___________ 9

c ^ __________________ 1 ___________ 1

（当然可能有更多行和更多独特的系列名称......）

所以在这个例子中，图表已经排序了，我希望有一个散点图，上面有3个系列（A是第1个，B是第2个，3个是第3个）

到目前为止，我有一个代码来创建一个带有一个系列的散点图，但我一直试图解决这个问题（代码如下所示）。任何有关解释的帮助都非常感谢：D

到目前为止，这是我的代码（没有动态系列部分ofc）

Sub creatingmyscatterplot()

'Dim aRng As Range
'Dim seriescheck As Range
Dim Chart1 As Chart
Set Chart1 = Charts.Add

'Set aRng = Selection.CurrentRegion
'Set aRng = aRng.Offset(1, 0).Resize(aRng.Rows.Count - 1)
'Set seriescheck = aRng.Resize(aRng.Rows.Count, 1)

'Dim seriesName As String, seriesData As Range
'These lines, as their names suggest, turn off screen refresh and recalculating the workbook's formulas before running the macro.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


With Chart1

    .ChartType = xlXYScatterLines
    .SeriesCollection.NewSeries

    'This creates the graph
    .SeriesCollection(1).Name = "=Sheet1!$A$2"
    .SeriesCollection(1).XValues = "=Sheet1!$B$2:$B$26001"
    .SeriesCollection(1).Values = "=Sheet1!$C$2:$C$26001"


    'Titles
    .HasTitle = True
    .ChartTitle.Characters.Text = "X vs. Y"
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "SOME TEXT"
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "SOME TEXT AS WELL"
    .Axes(xlCategory).HasMajorGridlines = True

    'Formatting
    .Axes(xlCategory).HasMinorGridlines = False
    .Axes(xlValue).HasMajorGridlines = True
    .Axes(xlValue).HasMinorGridlines = False
    .HasLegend = False
    .Axes(xlValue).MaximumScale = 100
    .Axes(xlValue).MinimumScale = 0

End With


'These lines, as their names suggest, turn off screen refresh and recalculating the workbook's formulas before running the macro.
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

抱歉第一行和最后一行的缩进。我只是希望这些行在代码块中，而不是在它之外。

谢谢：D

Answer 1

按照系列名称收集范围后，添加系列。

Sub creatingmyscatterplot()
Dim rngData() As Range, rngDB As Range
Dim Ws As Worksheet
Dim i As Long, n As Long

Set Ws = Sheets(1)
    With Ws
        Set rngDB = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
    End With
    'By same value area, set rngData() array
    n = 1
    ReDim Preserve rngData(1 To n) 'dynamic array
    For i = 1 To rngDB.Rows.Count
        If rngData(n) Is Nothing Then
           Set rngData(n) = rngDB(i)
        Else
            Set rngData(n) = Union(rngData(n), rngDB(i))
        End If
        If rngDB(i) <> rngDB(i + 1) Then
            n = n + 1
            ReDim Preserve rngData(1 To n)
        End If
    Next i

'Dim aRng As Range
'Dim seriescheck As Range
Dim Chart1 As Chart
Set Chart1 = Charts.Add

'Set aRng = Selection.CurrentRegion
'Set aRng = aRng.Offset(1, 0).Resize(aRng.Rows.Count - 1)
'Set seriescheck = aRng.Resize(aRng.Rows.Count, 1)

'Dim seriesName As String, seriesData As Range
'These lines, as their names suggest, turn off screen refresh and recalculating the workbook's formulas before running the macro.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


With Chart1

    .ChartType = xlXYScatterLines
    'if your activecel in data range, series is created automatically Unintentionally. So,all series are to be deleted
    For i = .SeriesCollection.Count To 1 Step -1
        .SeriesCollection(i).Delete
    Next i
    'This creates the graph
    For i = 1 To n - 1 'useful rngData()'s count is n -1
        .SeriesCollection.NewSeries
        .SeriesCollection(i).Name = rngData(i)(1)
        .SeriesCollection(i).XValues = rngData(i).Offset(, 1)
        .SeriesCollection(i).Values = rngData(i).Offset(, 2)
    Next i

    'Titles
    .HasTitle = True
    .ChartTitle.Characters.Text = "X vs. Y"
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "SOME TEXT"
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "SOME TEXT AS WELL"
    .Axes(xlCategory).HasMajorGridlines = True

    'Formatting
    .Axes(xlCategory).HasMinorGridlines = False
    .Axes(xlValue).HasMajorGridlines = True
    .Axes(xlValue).HasMinorGridlines = False
    .HasLegend = False
    .Axes(xlValue).MaximumScale = 100
    .Axes(xlValue).MinimumScale = 0

End With


'These lines, as their names suggest, turn off screen refresh and recalculating the workbook's formulas before running the macro.
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

使用Microsoft Excel中的VBA动态创建包含系列的散点图

1 个答案: