Excel - 以编程方式获取图表中使用的数据

时间:2013-06-18 21:23:25

标签: excel vba excel-vba

我有一大组图表,它们都在一个大型Excel电子表格中使用不同的系列集合。

对于每个图表,我需要提供一个数据表,其中仅包含该图表中使用的数据。因此,如果图表A显示了4个类别中每个类别的20个数据点,那么我想要的最终结果是一个包含20行和4列的表 - 正好是80个单元格,这些数据点出现在图表中。 (加上系列标题的行和列。)

我现在这样做的方法是右键单击图表系列并使用Select data突出显示基础系列。然后我把那个系列复制到一边,然后重复,直到我编制了表格。

毋庸置疑,这非常耗时,而且极易受到人为错误的影响。有没有办法以编程方式使用VBA或其他任何东西?

2 个答案:

答案 0 :(得分:0)

这应该足以让你入门。您需要根据自己的需要对其进行修改,但这会向您介绍您需要使用的属性。

如何构建“导出”数据最终取决于您。我举例说明如何使用Application.Transpose函数将其写入工作表,但您需要修改该部分以满足您的需求。

Sub DebugChartData()

Dim cht As ChartObject
Dim srs As Series
Dim lTrim#, rTrim#
Dim xValAddress As String

For Each cht In ActiveSheet.ChartObjects  '## iterate over all charts in the active sheet
    For Each srs In cht.Chart.SeriesCollection  '## iterate over all series in each chart
    '## The following given only to illustrate some of
    '    the properties available which you might find useful
    '    You will want to print these out to a worksheet, presumably,
    '    but I don't know how you intend to arrange these, on what
    '    sheet, etc, so I will leave that part up to you :)
        Debug.Print srs.Name
        Debug.Print vbTab & srs.Formula  '# probably not so useful to you but I include it anyways.
    '##  You could parse the formula...
        lTrim = InStrRev(srs.Formula, ",", InStrRev(srs.Formula, ",") - 1, vbBinaryCompare) + 1
        rTrim = InStrRev(srs.Formula, ",")
        xValAddress = Mid(srs.Formula, lTrim, rTrim - lTrim)
        Debug.Print vbTab & xValAddress
    '## , but that hardly seems necessary. You could convert the array of
    '   values/xvalues in to a delimited string and then do a text-to-columns on the data
        Debug.Print vbTab & Join(srs.XValues, vbTab)
        Debug.Print vbTab & Join(srs.Values, vbTab)
    '## Or, you could use Application.Transpose to write out on a worksheet
        'Qualify this with the appropriate Destination sheet, also make the destination variable
        ' as you accommodate multiple series/charts worth of data.
        Range("A1").Resize(UBound(srs.XValues)) = Application.Transpose(srs.Values)

    Next
Next

End Sub

答案 1 :(得分:-1)

这是我的图表中的一个例子。唯一的事情是你必须在“选择数据”中设置前几行,这将定义其余部分。

    Max = Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row - 13
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(1).XValues = Sheets(2).Range("A4:A" & Max)
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(1).Values = Sheets(2).Range("B4:B" & Max)
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(1).Name = "Comet"
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(2).XValues = Sheets(2).Range("C4:C370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(2).Values = Sheets(2).Range("D3:D370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(2).Name = "Mercury"
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(3).XValues = Sheets(2).Range("E4:E370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(3).Values = Sheets(2).Range("F4:F370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(3).Name = "Venus"
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(4).XValues = Sheets(2).Range("G4:G370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(4).Values = Sheets(2).Range("H4:H370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(4).Name = "Earth"
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(5).XValues = Sheets(2).Range("I4:I370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(5).Values = Sheets(2).Range("J4:J370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(5).Name = "Mars"
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(6).XValues = Sheets(2).Range("K4:K370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(6).Values = Sheets(2).Range("L4:L370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(6).Name = "Jupiter"
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(7).XValues = Sheets(2).Range("M4:M370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(7).Values = Sheets(2).Range("N4:N370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(7).Name = "Saturn"
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(8).XValues = Sheets(2).Range("O4:O370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(8).Values = Sheets(2).Range("P4:P370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(8).Name = "Uranus"
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(9).XValues = Sheets(2).Range("Q4:Q370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(9).Values = Sheets(2).Range("R4:R370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(9).Name = "Neptune"
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(10).XValues = Sheets(2).Range("S4:S370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(10).Values = Sheets(2).Range("T4:T370")
    Sheets("Graph").ChartObjects("Chart 1").Chart.SeriesCollection(10).Name = "Pluto"