0

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

对于每个图表，我需要提供一个仅包含该图表中使用的数据的数据表。因此，如果图表 A 为 4 个类别中的每个类别显示 20 个数据点，我想要的最终结果是一个有 20 行和 4 列的表格——恰好有 80 个单元格，即图表中出现的数据点。（加上系列标题的一行和一列。）

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

不用说，这非常耗时，并且极易出现人为错误。有没有办法使用 VBA 或其他任何东西以编程方式执行此操作？

4

2 回答 2

1

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

如何构建“导出”数据最终取决于您。我举了一个例子，说明如何用函数将其写到工作表中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
于 2013-06-19T01:59:14.770 回答
-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"
于 2013-06-19T02:57:47.243 回答