Excel - 以編程方式獲取圖表中使用的數據

我有一大套圖表，它們都在一個大型Excel電子表格中使用不同的系列集合。Excel - 以編程方式獲取圖表中使用的數據

對於每個圖表，我需要提供一個包含的數據表，僅使用該圖表中使用的數據。因此，如果圖表A顯示了4個類別中的20個數據點，我想要的最終結果是一個包含20行和4列的表格 - 完全爲80個單元格，這些數據點出現在圖表中。（加上系列標題的一行和一列）。

我現在這樣做的方式是右鍵單擊圖表系列並使用Select data突出顯示底層系列。然後我將該系列文件複製到一邊，然後重複，直到我編譯完表格。不用說，這是非常耗時的，並且極易受人爲錯誤的影響。有沒有辦法使用VBA或其他方式來編程？

來源

2013-06-18 supertrue

您是否嘗試過手動操作並將操作記錄爲宏？當我這樣做時，我發現單個命令「ActiveChart.ApplyLayout（5）'做了許多魔術。也許類似的東西會爲你工作？ – Floris

查看['Chart']（http://msdn.microsoft.com/zh-cn/library/office/aa213725（v = office.11）.aspx）對象的方法，特別是'Chart.XValues' ，Chart.SeriesCollection（i）.XValues'和Chart.SeriesCollection（i）.YValues'。 – Chel

這應該足以讓你開始。您需要根據自己的目的對其進行修改，但這會向您介紹您需要使用的屬性。

您如何構造「導出」數據最終取決於您。我舉例說明如何用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-19 01:59:14

爲了說明一下，只要沒有涉及到公式，我可以通過''''''''''''''''''''註釋刪除'Debug.Print vbTab＆srs.Formula'之間的所有行嗎？ – supertrue

是的，你可以刪除這些行。我在這段代碼中僅舉了幾個例子來展示訪問圖表數據部分的各種方法。這些線路尤其可能不是您想要使用的方法。 –

@supertrue你有機會嘗試一下嗎？如果是這樣，並且對你有幫助，請考慮「接受」這個答案。如果您遇到問題，請告訴我，我可以幫助修改。 –

-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-19 02:57:47

這似乎根本不是OP所要求的，或者與OP所要求的完全相反。您的代碼演示瞭如何將Range參數引入'Series'屬性。 OP需要將這些屬性轉換回（另一個）工作表/表格。 –

Excel - 以編程方式獲取圖表中使用的數據

回答

相關問題