Question

我非常擅长excel vba并且正在使用这个第一次尝试作为学习经历。我希望在与他们从中获取数据的工作表单独的工作表中制作一个散点图矩阵。

因此，我想在Excel工作表中生成一种图表示意图。这表示单个satterplot [x轴（ColumnletterRownumber），y轴（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范围以及范围名称和大小的代码。记录完成后，您可以将新范围换成变量以获得新图表。

使用VBA在Excel中的多个图形

2 个答案: