0

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

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

4

1 回答 1

0

这里有一些东西可以帮助您入门。每次对数据进行排序/重新排序时，您都必须运行宏“UpdateChart”，但这似乎对我有用。

我Names在宏中创建了一些，然后将系列值和 XValues 设置为这些范围，尽管这并不是绝对必要的。

截图

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

修订

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

这是一个不使用的修改版本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
于 2013-04-23T16:03:41.253 回答