使用VBA的excel中的多个图表

Question

我对 excel vba 非常陌生，我将第一次尝试用作学习经验。我希望在他们从中获取数据的工作表中制作一个单独的工作表中的散点图矩阵。

这是我想在 Excel 表中生成的一种图表示意图。这表示单个卫星图 [x-axis(ColumnletterRownumber), y-axis(ColumnletterRownumber)]

[(S2:S372),(AW2:AW372)​​] [(T2:T372),(AW2:AW372)​​] [(U2:U372),(AW2:AW372)​​]

[(S2:S372),(AX2:AX372)] [(T2:T372),(AX2:AX372)] [(U2:U372),(AX2:AX372)]

[(S2:S372),(AY2:AY372)] [(T2:T372),(AY2:AY372)] [(U2:U372),(AY2:AY372)]

[(S2:S372),(AZ2:AZ372)] [(T2:T372),(AZ2:AZ372)] [(U2:U372),(AZ2:AZ372)]

所以这些将是下一张纸上的散点图。显然我需要比这更多的图表，但这应该会给你一个想法。

这是我目前得到的： 提前对大量注释掉的东西表示抱歉……我认为这些想法可能会有所帮助，但我还没有让它们发挥作用。

---

Sub SPlotMatrix1()


Application.ScreenUpdating = False


'SPlotMatrix1 Macro


'Define the Variables

'---------------------

Dim Xaxis As range

Dim Yaxis As range


''Initialize the Variables

''-------------------------


Set Xaxis = range("S2:S372")

Set Yaxis = range("AW2:AW372")




'Tell macro when to stop

'-----------------------

Dim spot As Long


spot = 0


Do Until spot > 50


Sheets("2ndFDAInterimData").Select

''MAIN LOOP


'Graph1

'-------

'Selection Range


   range("S2:S372,AW2:AW372").Select

   'range("Xaxis,Yaxis").Select

   'range("AW1:AW372",S1:S372").Offset(0, rng).Select


    'range("AW1:AW372", 0).Select

    'range("0,S1:S372").Offset(0, rng).Select


    range("S372").Activate

'Select Graph Range

    ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select

'    ActiveChart.SetSourceData Source:=range( _

        "'2ndFDAInterimData'!$AW$1:$AW$372,'2ndFDAInterimData'!$S$1:$S$372")

'Graph Title

    ActiveChart.SetElement (msoElementChartTitleAboveChart)

    ActiveChart.FullSeriesCollection(1).Select

    ActiveChart.FullSeriesCollection(1).name = "='2ndFDAInterimData'!$DL$1"

'Add Trendline

    ActiveChart.Axes(xlValue).MajorGridlines.Select

    ActiveChart.FullSeriesCollection(1).Trendlines.Add Type:=xlLinear, Forward _

        :=0, Backward:=0, DisplayEquation:=0, DisplayRSquared:=0, name:= _

        "Linear (Ave.Score)"

    ActiveChart.FullSeriesCollection(1).Trendlines.Add Type:=xlLinear, Forward _

        :=0, Backward:=0, DisplayEquation:=0, DisplayRSquared:=0, name:= _

        "Linear (Ave.Score)"

    ActiveChart.FullSeriesCollection(1).Trendlines(2).Select

    Selection.DisplayRSquared = True

'Move Rsquare Label to Corner

    ActiveChart.FullSeriesCollection(1).Trendlines(2).DataLabel.Select

    Selection.Left = 30.114

    Selection.Top = 13.546

'Format Trendline

    ActiveChart.FullSeriesCollection(1).Trendlines(2).Select

    With Selection.Format.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorText1

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = 0

        .Transparency = 0

    End With

    With Selection.Format.Line

        .Visible = msoTrue

        .DashStyle = msoLineSolid

    End With

    ActiveChart.ChartArea.Select

    With Selection.Format.Line

        .Visible = msoTrue

        .Weight = 1.75

    End With

'Resize Graph

    ActiveChart.Parent.Height = 180

    ActiveChart.Parent.Width = 239.76

'Y axis scale

    ActiveChart.FullSeriesCollection(1).Select

    ActiveChart.Axes(xlValue).Select

    ActiveChart.Axes(xlValue).MaximumScale = 100

'Move graph to center (for the purposes of design and debugging)

    ActiveChart.Parent.Cut

    range("V4").Offset(spot, 0).Select

    ActiveSheet.Paste



' 'Move Graph to other sheet

'    ActiveChart.Parent.Cut

'    Sheets("graphs").Select

'    range("A1").Offset(spot, 0).Select

'    ActiveSheet.Paste




spot = spot + 14


Loop





Application.ScreenUpdating = True



End Sub

---

如果我愿意，我可以在一行或一列中创建多个相同的图表。但我无法成功更改图表范围，以便它们绘制不同的数据。

请帮忙，如果我能进一步澄清，请告诉我。谢谢！

Answer 1

您可以使用几个简单的循环来定义数据。创建图表并在内部循环中对其进行修饰。

Sub InsertMultipleCharts()
  ' data particulars
  Dim wksData As Worksheet
  Const Xcol1 As Long = 19 ' column S
  Const Xcol2 As Long = 21 ' column U
  Const Ycol1 As Long = 49 ' column AW
  Const Ycol2 As Long = 52 ' column AZ
  Const Row1 As Long = 2
  Const Row2 As Long = 372

  ' chart dimensions
  Const FirstChartLeft As Long = 50
  Const FirstChartTop As Long = 50
  Const ChartHeight As Long = 180
  Const ChartWidth As Long = 240

  ' working variables
  Dim wksChart As Worksheet
  Dim cht As Chart
  Dim Xrange As Range
  Dim Yrange As Range
  Dim Xcol As Long
  Dim Ycol As Long

  ' define sheets
  Set wksData = ActiveSheet
  Set wksChart = Worksheets.Add

  ' loop X
  For Xcol = Xcol1 To Xcol2
    ' define x values
    Set Xrange = Range(wksData.Cells(Row1, Xcol), wksData.Cells(Row2, Xcol))

    ' loop Y
    For Ycol = Ycol1 To Ycol2
      ' define y values
      Set Yrange = Range(wksData.Cells(Row1, Ycol), wksData.Cells(Row2, Ycol))

      ' insert chart
      Set cht = wksChart.Shapes.AddChart2(Style:=240, XlChartType:=xlXYScatter, _
                  Left:=FirstChartLeft + (Xcol - Xcol1) * ChartWidth, _
                  Top:=FirstChartTop + (Ycol - Ycol1) * ChartHeight, _
                  Width:=ChartWidth, Height:=ChartHeight).Chart

      ' assign data to chart
      cht.SetSourceData Source:=Union(Xrange, Yrange)

      ' chart title
      cht.HasTitle = True
      With cht.ChartTitle.Font
        .Size = 12
        .Bold = False
      End With

      ' axis scale
      cht.Axes(xlValue).MaximumScale = 100

      ' legend
      cht.HasLegend = False

      ' series: name, trendline, and Rsquared
      With cht.SeriesCollection(1)
        .Name = "Series Name" '''' don't know where these are coming from
        With .Trendlines.Add(Type:=xlLinear, DisplayRSquared:=True).DataLabel
          .Format.Line.DashStyle = msoLineSolid
          .Top = cht.PlotArea.InsideTop
          .Left = cht.PlotArea.InsideLeft
        End With
      End With
    Next
  Next
End Sub

宏记录器代码很乱，但它提供了语法。

Answer 2

尝试使用宏记录器编辑现有范围，以便获得用于设置 X、Y 范围以及范围名称和大小的代码。 记录后，您可以将新范围换成变量以获得新图表。