在Excel中使用VBA的多个图表

我对excel vba非常陌生,并且正在使用这个第一次尝试作为学习经验。 我希望能够从他们正在从中获取数据的工作表创build一个散布图matrix。

所以inheritance人是我想在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 

如果需要的话,我已经到了可以在行或列中创build许多相同graphics的地步。 但是我无法成功获取图表范围来改变,以便绘制不同的数据。

请帮助,让我知道,如果我可以进一步澄清。 谢谢!

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

 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 

macroslogging器代码是混乱的,但它给你的语法。

尝试使用macroslogging器编辑现有范围,以便获取设置X,Y和范围名称和大小范围的代码。 一旦logging,您可以换出新的范围作为variables来获得新的图表。