Question

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

    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中是否可行吗？

Answer 1

这是让你入门的东西。每次对数据进行排序/重新排序时都必须运行宏“UpdateChart”，但这似乎对我有用。

我在宏中创建了一些Names，然后设置了系列值＆amp; XValues到那些范围，虽然这不是严格必要的。

screenshot of "series 2" after the update macro

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

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

这是一个不使用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

    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

使用公式选择图表数据

1 个答案: