在microsoft excel中使用VBA动态创建包含系列的散点图

Question

我对 VBA 比较陌生，因此我希望能更全面地解释您为解决这个小问题所做的工作。

我的任务是创建一个简单的 VBA 程序，该程序采用一组已经排序的数据（我了解了它，然后使用 VBA 程序根据特定列的值按字母顺序对我的数据进行排序）并执行以下两件事用它：

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

与

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

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

系列名称___X 值_____Y 值

A__________________1___________1

A__________________2___________2

A__________________3___________3

A__________________4___________4

B__________________5___________5

B__________________6___________6

B__________________7___________7

C__________________8___________8

C__________________9___________9

C__________________1___________1

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

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

到目前为止，我有代码可以创建一个系列的散点图，但我一直试图弄清楚这一点（代码如下所示）。非常感谢任何解释帮助：D

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

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