excel 中的多个图表使用 VBA
Multiple graphs in excel using VBA
我对 excel vba 非常陌生，我将第一次尝试作为学习经验。我希望在与他们从中获取数据的 sheet 分开的 sheet 中制作一个散点图矩阵。
所以这是我想在 excel sheet 中生成的一种图表示意图。这表示单个散点图 [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)]
所以这些将是下一个 sheet 的散点图。显然我需要比这更多的图表，但这应该会给你一个想法。
这是我目前得到的：
提前为大量注释掉的东西道歉......我认为这些想法可能会有所帮助，但我还没有让它们发挥作用。
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:$AW2,'2ndFDAInterimData'!$S:$S2")
'Graph Title
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).name = "='2ndFDAInterimData'!$DL"
'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
我已经到了可以根据需要在一行或一列中创建多个相同图表的地步。但是我无法成功地更改图表范围，以便它们绘制不同的数据。
请帮忙，让我知道是否可以进一步澄清。谢谢！
尝试使用宏录制器编辑现有范围，以便获得用于设置 X、Y 范围以及范围名称和大小的代码。
记录后，您可以将新范围作为变量换出以获得新图表。
您可以使用几个简单的循环来定义数据。创建图表并在内循环中对其进行修饰。
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
宏记录器代码很乱，但它给了你语法。
我对 excel vba 非常陌生，我将第一次尝试作为学习经验。我希望在与他们从中获取数据的 sheet 分开的 sheet 中制作一个散点图矩阵。
所以这是我想在 excel sheet 中生成的一种图表示意图。这表示单个散点图 [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)]
所以这些将是下一个 sheet 的散点图。显然我需要比这更多的图表，但这应该会给你一个想法。
这是我目前得到的： 提前为大量注释掉的东西道歉......我认为这些想法可能会有所帮助，但我还没有让它们发挥作用。
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:$AW2,'2ndFDAInterimData'!$S:$S2")
'Graph Title
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).name = "='2ndFDAInterimData'!$DL"
'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
我已经到了可以根据需要在一行或一列中创建多个相同图表的地步。但是我无法成功地更改图表范围，以便它们绘制不同的数据。
请帮忙，让我知道是否可以进一步澄清。谢谢！
尝试使用宏录制器编辑现有范围，以便获得用于设置 X、Y 范围以及范围名称和大小的代码。 记录后，您可以将新范围作为变量换出以获得新图表。
您可以使用几个简单的循环来定义数据。创建图表并在内循环中对其进行修饰。
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
宏记录器代码很乱，但它给了你语法。