使用公式来选择图表数据 [英] Use formulas to select chart data

查看:114
本文介绍了使用公式来选择图表数据的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我有一个大数据表,有许多不同的测量和参数。我正在尝试创建一些基于参数组织数据系列的图表。例如,如果我有这样的数据:

 
Xval Yval ParA ParB
22 5 10 0.25
27 7 10 0.5
26 6 20 0.25
25 8 20 0.5

我可能想要创建两个图表 - 对于ParA的每个值都有一系列,对于ParB的每个值都有一系列。我想做的是能够通过论坛定义系列数据,例如(sudocode)

  Series1x = Xval,IF (ParA == 10)
Series1y = Yval,IF(ParA == 10)
Series2x = Xval,IF(ParA == 20)
Series2y = Yval,IF(ParA == 20 )

这样我可以继续排序,但是我喜欢,也不会改变图表。我知道我可以通过F9将选择的数据转换为原始数据,但是我想在多个数据集上重用系列选择。



有没有人知道如果这在Excel中是可行的?

解决方案

这是一个让你开始的事情。每次排序/重新排序数据时,都必须运行宏UpdateChart,但这似乎对我来说很有用。



我创建了一些名称在宏中,然后设置系列值&对这些范围来说,虽然不是必须的,但它们并不是必须的。



  Sub UpdateChart()
Dim cht As图
Dim srs As Series
Dim s1xVals As Range
Dim s1Vals As Range
Dim s1Test As Double
Dim s2Test As Double
Dim nmAddress As String
Dim nm1 As Name
Dim nm2 As Name
Dim parAVals As Range

设置parAVals = GetRange(定义ParA范围)

设置s1xVals = GetRange(X值?)
设置s1Vals = GetRange(Y值?)
s1Test = Application.InputBox(ParA的什么过滤器值,系列1过滤器)
s2Test = Application.InputBox(ParA的什么过滤器值,系列2过滤器)

'获取与系列1的过滤规则匹配的所有单元格的地址'
nmAddress = GetAddress(s1xVals, parAVals,s1Test)

'将名称添加到工作簿中:'
ActiveWorkbook.Names.Add名称:=Srs1_XValues,RefersTo:= Range(nmAddress),Visible:= True
'为Y值重复
nmAddress = GetAddress(s1Vals,parAVals,s1Test)
ActiveWorkbook.Names.Add名称:=Srs1_YValues,RefersTo:= Range(nmAddress),Visible: = True

'为系列2重复:
nmAddress = GetAddress(s1xVals,parAVals,s2Test)
ActiveWorkbook.Names.Add名称:=Srs2_XValues,RefersTo:=范围(nmAddress),可见:= True
nmAddress = GetAddress(s1Vals,parAVals,s2Test)
ActiveWorkbook.Names.Add名称:=Srs2_YValues,RefersTo:= Range(nmAddress),Visible:= True



设置cht = ActiveSheet.ChartObjects(1).Chart'##根据需要进行修改'

'删除现有的任何数据图表或根据需要修改'
对于每个srs在cht.SeriesCollection
srs.Delete
下一个

'A dd第一个系列:'
Set srs = cht.SeriesCollection.NewSeries
srs.XValues = Range(srs1_XValues)
srs.Values = Range(srs1_YValues)
srs.Name =Series 1 Name'##根据需要修改'

'添加第二个系列:'
设置srs = cht.SeriesCollection.NewSeries
srs。
srs.Values = Range(srs2_YValues)
srs.Name =Series 2 Name'##根据需要进行修改'


End Sub

函数GetAddress(srsVals As Range,filterVals As Range,filterCriteria As Double)

Dim cl As Range
Dim c As Long :c = 1
Dim tmpAddress As String

对于每个cl在filterVals
如果cl.Value = filterCriteria然后
Debug.Print srsVals.Cells(c)。值
'创建单元格地址匹配条件的字符串值
如果tmpAddress = vbNullString Then
tmpAddress = srsVals.Cells(c).Address
Else:
tmpAddress = tmpAddress& ,& srsVals.Cells(c).Address
End If
End If
c = c + 1
Next

GetAddress = tmpAddress

结束函数

私有函数GetRange(msg As String)As Range

设置GetRange = Application.InputBox(msg,Type:= 8)

结束功能

REVISION



当返回超过255个字符的字符串时,上述方法失败,无法将地址分配给名称或系列。



以下是不使用 Names 的修改版本,它只将过滤的分数收集到数组中,并使用这些来定义系列。



像上面的解决方案一样,你必须在更改数据时运行它。

  Sub UpdateChartNoNames()
Dim cht As Chart
Dim srs As Series
Dim s1xVals As Range
Dim s1Vals As Range
Dim s1Test As Double
Dim s2Test As Double
Dim parAVals As Range

设置parAVals = GetRange(定义ParA范围)
设置s1xVals = GetRange X值?)
设置s1Vals = GetRange(Y值?)

'##或者,您可以在不使用输入框的情况下设置这些范围:'
'设置parAvals =范围(C2:C300)'
'设置s1XVals =范围(A2:A300)'
'设置s1Vals =范围(B2:B300)'

s1Test = Application.InputBox(ParA的什么过滤器值,系列1过滤器)
s2Test = Application.InputBox(ParA的什么过滤器值,系列2过滤器)

设置cht = ActiveSheet.ChartObjects(1).Chart'##根据需要进行修改'

'删除图表中的任何现有数据,或根据需要进行修改。
对于每个srs在cht.SeriesCollection
srs.Delete
下一个

'添加第一个系列:'
Set srs = cht.SeriesCollecti on.NewSeries
srs.XValues = GetValues(s1xVals,parAVals,s1Test)
srs.Values = GetValues(s1Vals,parAVals,s1Test)
srs.Name =Series 1 Name'# #

'添加第二个系列:'
设置srs = cht.SeriesCollection.NewSeries
srs.XValues = GetValues(s1xVals,parAVals,s2Test)
srs.Values = GetValues(s1Vals,parAVals,s2Test)
srs.Name =Series 2 Name'##根据需要进行修改'


End Sub

函数GetValues(srsVals As Range,filterVals As Range,filterCriteria As Double)As Variant

Dim cl As Range
Dim c As Long:c = 0
Dim tmpVar As Variant

ReDim tmpVar(0)
对于每个cl在filterVals
如果cl.Value = filterCriteria然后
'Debug.Print srsVals。单元格(c).Value'
'创建单元格地址匹配条件'
的字符串值ReDim保存tmpVar(c)
tmpVar(c)= srsVals.Cells(c).Value
c = c + 1
End If
Next

GetValues = tmpVar

结束函数

私有函数GetRange(msg As String)As Range

Set GetRange = Application.InputBox(msg,Type: = 8)

结束功能


I have a large data table with a number of different measurements and parameters. I am trying to create a number of charts that organize the data series based on the parameters. For example, if I had data like this:

    Xval    Yval    ParA    ParB
    22      5       10      0.25
    27      7       10      0.5
    26      6       20      0.25
    25      8       20      0.5

I might want to create two charts - one that has a series for each value of ParA, and one that has a series for each value of ParB. What I want to do is be able to define the series data forumlaicly, saying something like (sudocode)

Series1x = Xval, IF(ParA==10)
Series1y = Yval, IF(ParA==10)
Series2x = Xval, IF(ParA==20)
Series2y = Yval, IF(ParA==20)

This way I can continue to sort however I like, and no change to the chart. I know that I can F9 the selected data to convert to raw numbers, but I would like to be able to reuse the series selection on multiple data sets.

Does anyone know if this is even possible in Excel?

解决方案

Here is something to get you started. You will have to run the macro "UpdateChart" each time you sort/re-sort the data, but this seems to be working for me.

I create some Names in the macro, and then set the series Values & XValues to those ranges, although that would not strictly be necessary.

Sub UpdateChart()
    Dim cht As Chart
    Dim srs As Series
    Dim s1xVals As Range
    Dim s1Vals As Range
    Dim s1Test As Double
    Dim s2Test As Double
    Dim nmAddress As String
    Dim nm1 As Name
    Dim nm2 As Name
    Dim parAVals As Range

    Set parAVals = GetRange("Define the ParA range?")

    Set s1xVals = GetRange("X Values?")
    Set s1Vals = GetRange("Y Values?")
    s1Test = Application.InputBox("What filter value for ParA?", "Series 1 Filter")
    s2Test = Application.InputBox("What filter value for ParA?", "Series 2 Filter")

    'Get the address of all cells matching the filter rule for series 1.'
    nmAddress = GetAddress(s1xVals, parAVals, s1Test)

    'Add the name to the workbook:'
    ActiveWorkbook.Names.Add Name:="Srs1_XValues", RefersTo:=Range(nmAddress), Visible:=True
    'Repeat for the Y Values'
    nmAddress = GetAddress(s1Vals, parAVals, s1Test)
    ActiveWorkbook.Names.Add Name:="Srs1_YValues", RefersTo:=Range(nmAddress), Visible:=True

    'Repeat for series 2:'
    nmAddress = GetAddress(s1xVals, parAVals, s2Test)
    ActiveWorkbook.Names.Add Name:="Srs2_XValues", RefersTo:=Range(nmAddress), Visible:=True
    nmAddress = GetAddress(s1Vals, parAVals, s2Test)
    ActiveWorkbook.Names.Add Name:="Srs2_YValues", RefersTo:=Range(nmAddress), Visible:=True



    Set cht = ActiveSheet.ChartObjects(1).Chart '## Modify as needed.'

    'remove any existing data in the chart, or modify as needed.'
    For Each srs In cht.SeriesCollection
        srs.Delete
    Next

    'Add the first series:'
    Set srs = cht.SeriesCollection.NewSeries
        srs.XValues = Range("srs1_XValues")
        srs.Values = Range("srs1_YValues")
        srs.Name = "Series 1 Name"          '## modify as needed.'

    'Add the second series:'
    Set srs = cht.SeriesCollection.NewSeries
        srs.XValues = Range("srs2_xValues")
        srs.Values = Range("srs2_YValues")
        srs.Name = "Series 2 Name"          '## modify as needed.'


End Sub

Function GetAddress(srsVals As Range, filterVals As Range, filterCriteria As Double)

    Dim cl As Range
    Dim c As Long: c = 1
    Dim tmpAddress As String

    For Each cl In filterVals
        If cl.Value = filterCriteria Then
            Debug.Print srsVals.Cells(c).Value
            'Create a string value of cell address matching criteria'
            If tmpAddress = vbNullString Then
                tmpAddress = srsVals.Cells(c).Address
            Else:
                tmpAddress = tmpAddress & "," & srsVals.Cells(c).Address
            End If
        End If
        c = c + 1
    Next

    GetAddress = tmpAddress

End Function

Private Function GetRange(msg As String) As Range

    Set GetRange = Application.InputBox(msg, Type:=8)

End Function

REVISION

The above method fails when returning string longer than 255 characters, not able to assign the address to a Name or to a series.

Here is a modified version that does not use Names, it merely collects the filtered scores in to an array, and uses those values to define the series.

Like the above solution, you would have to run it any time you change the data.

Sub UpdateChartNoNames()
    Dim cht As Chart
    Dim srs As Series
    Dim s1xVals As Range
    Dim s1Vals As Range
    Dim s1Test As Double
    Dim s2Test As Double
    Dim parAVals As Range

    Set parAVals = GetRange("Define the ParA range?")
    Set s1xVals = GetRange("X Values?")
    Set s1Vals = GetRange("Y Values?")

    '## Alternatively, you could set these ranges without using the inputbox:'
    'Set parAvals = Range("C2:C300")    '
    'Set s1XVals = Range("A2:A300")     '
    'Set s1Vals = Range("B2:B300")      '

    s1Test = Application.InputBox("What filter value for ParA?", "Series 1 Filter")
    s2Test = Application.InputBox("What filter value for ParA?", "Series 2 Filter")

    Set cht = ActiveSheet.ChartObjects(1).Chart '## Modify as needed.'

    'remove any existing data in the chart, or modify as needed.'
    For Each srs In cht.SeriesCollection
        srs.Delete
    Next

    'Add the first series:'
    Set srs = cht.SeriesCollection.NewSeries
        srs.XValues = GetValues(s1xVals, parAVals, s1Test)
        srs.Values = GetValues(s1Vals, parAVals, s1Test)
        srs.Name = "Series 1 Name"          '## modify as needed.'

    'Add the second series:'
    Set srs = cht.SeriesCollection.NewSeries
        srs.XValues = GetValues(s1xVals, parAVals, s2Test)
        srs.Values = GetValues(s1Vals, parAVals, s2Test)
        srs.Name = "Series 2 Name"          '## modify as needed.'


End Sub

Function GetValues(srsVals As Range, filterVals As Range, filterCriteria As Double) As Variant

    Dim cl As Range
    Dim c As Long: c = 0
    Dim tmpVar As Variant

    ReDim tmpVar(0)
    For Each cl In filterVals
        If cl.Value = filterCriteria Then
            'Debug.Print srsVals.Cells(c).Value'
            'Create a string value of cell address matching criteria'
            ReDim Preserve tmpVar(c)
            tmpVar(c) = srsVals.Cells(c).Value
            c = c + 1
        End If
    Next

    GetValues = tmpVar

End Function

Private Function GetRange(msg As String) As Range

    Set GetRange = Application.InputBox(msg, Type:=8)

End Function

这篇关于使用公式来选择图表数据的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆