从两个或多个不同的工作表创建一个图形

Question

我正在创建一个宏，它根据使用输入框选择的数据创建一个 xy 图。我运行遇到了两个问题（一大一小）。

每当我尝试 select 来自不同工作表的数据时，都会收到一条错误消息。如何使宏能够使用来自多个不同工作表的数据？（我怀疑问题出在评论下，“使用输入框设置额外的y值”，但我不确定）报错信息为“运行-time error 1004: range class的选择方法失败”，指的是行

myAddTitle.OFFEST(1, 0).Select

在我尝试 select 我的第二个系列的新工作表中的数据之后。

不管我给series 1取什么名字，图例都是series 1，怎么才能和myYTitle对应呢？

如有任何建议，我们将不胜感激！谢谢！

'''

Sub InsertFSC()
'
'
'
'
`With ActiveSheet
'
' Set x values with input box
Dim myXCell As Range
Dim myXSeries As Range
Dim myXTitle As Range
Set myXTitle = Application.InputBox("Please select the heading of the column which contains 
your desired X values:", "Select title cell", Type:=8)
myXTitle.OFFSET(1, 0).Select
Set myXCell = Selection
Range(myXCell, myXCell.End(xlDown)).Select
Set myXSeries = Selection
'
'
' Set y values with input box
Dim myYCell As Range
Dim myYSeries As Range
Dim myYTitle As Range
Set myYTitle = Application.InputBox("Please select the heading of the column which contains your desired Y values:", "Select title cell", Type:=8)
myYTitle.OFFSET(1, 0).Select
Set myYCell = Selection
Range(myYCell, myYCell.End(xlDown)).Select
Set myYSeries = Selection
'
'
' Create Blank Graph
Dim chartObj As ChartObject
Dim DataChart As Chart
Set chartObj = ActiveSheet.ChartObjects.Add(Top:=10, Left:=325, Width:=600, Height:=300)
Set DataChart = chartObj.Chart
DataChart.ChartType = xlXYScatterSmooth
'
'
' Remove auto-plotted data
Do While DataChart.SeriesCollection.Count > 0
DataChart.SeriesCollection(1).Delete
Loop
'
'
' Add first data series
With DataChart.SeriesCollection.NewSeries
    .Name = myYTitle
    .XValues = myXSeries
    .Values = myYSeries
End With
'
'
'
' Formatting
' Display a message box with yes/no and question icon - want to continue?
If MsgBox("Would you like to add another Y data series to your graph?", vbQuestion + vbYesNo + vbDefaultButton2, "Continue?") = vbYes Then
     MsgBox "The user clicked Yes"
'
'
'
' BEGIN THE LOOP of selecting additional Y values until user selects NO
Do Until answer = vbNo
'
' Set additional y values with input box
Dim myAddCell As Range
Dim myAddSeries As Range
Dim myAddTitle As Range
Set myAddTitle = Application.InputBox("Please select the heading of the column which contains the Y values you want to add:", "Select title cell", Type:=8)
myAddTitle.OFFSET(1, 0).Select
Set myAddCell = Selection
Range(myAddCell, myAddCell.End(xlDown)).Select
Set myAddSeries = Selection
'
'
' Add the new data to graph
With DataChart.SeriesCollection.NewSeries
   .Name = myAddTitle
   .XValues = myXSeries
   .Values = myAddSeries
End With
'
'
' Display message box with yes/no and question icon
answer = MsgBox("Would you like to continue and select another Y data series?", vbQuestion + vbYesNo + vbDefaultButton2, "Continue?")
' END OF LOOP
Loop
Else
     MsgBox "The user clicked No"
End If
'
'
'
' Add a chart title and axis labels with input box
With DataChart
    .HasTitle = True
    .ChartTitle.Text = Application.InputBox("Please enter a chart title", "Chart Title Name", Type:=2)
' Add X Axis title
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = myXTitle
' Add Y Axis title with input box?
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Application.InputBox("Please enter the Y axis title", "Y axis Name", Type:=2)
End With
'
'
End With
End Sub

'''

Answer 1

试试这个：

Sub InsertFSC()

    Dim xVals As Range, yVals As Range, allYVals As Collection
    Dim chartObj As ChartObject
    Dim DataChart As Chart
    
    Set allYVals = New Collection
    
    Set xVals = GetRange("Please select the heading of the column which contains your desired X values:")
    If xVals Is Nothing Then Exit Sub 'cancelled xvals selection
    'loop and collect Yvalue column(s)
    Do
        Set yVals = GetRange("Please select Y values column header (or cancel if done):")
        If Not yVals Is Nothing Then
            allYVals.Add yVals
        Else
            Exit Do 'user is done selecting
        End If
    Loop
    
    If allYVals.Count = 0 Then Exit Sub 'didn't get any yvalues selected
    
    'add the chart
    Set chartObj = ActiveSheet.ChartObjects.Add(Top:=10, Left:=325, Width:=600, Height:=300)
    Set DataChart = chartObj.Chart
    DataChart.ChartType = xlXYScatterSmooth

    ' Remove auto-plotted data
    Do While DataChart.SeriesCollection.Count > 0
        DataChart.SeriesCollection(1).Delete
    Loop
    'loop over the collected y values ranges and add a series for each one
    For Each yVals In allYVals
        With DataChart.SeriesCollection.NewSeries
           .Name = yVals.Cells(1).Value
           .XValues = xVals.Offset(1, 0).Resize(xVals.Rows.Count - 1) 'move/resize to exclude header
           .Values = yVals.Offset(1, 0).Resize(xVals.Rows.Count - 1)
        End With
    Next
End Sub

'return a user-selected range or Nothing
Function GetRange(msg As String)
    Dim rv As Range
    On Error Resume Next
    Set rv = Application.InputBox(msg, "Select title cell", Type:=8)
    On Error GoTo 0
    If Not rv Is Nothing Then
        Set rv = rv.Parent.Range(rv, rv.End(xlDown))
    End If
    Set GetRange = rv
End Function

如果这是一般用途，您应该在用户选择的范围上添加一些检查 - 例如。确保范围不为空，仅选择一列，范围不跨越整列（或不超过某些合理的大小限制），并且 X 和 Y 范围大小相同。

从两个或多个不同的工作表创建一个图形

Creating one graph from two or more different worksheets

excel

vba

excel-charts