2013-06-18 2 views
0

У меня есть большой набор диаграмм, которые используют разные коллекции серий в одной крупной электронной таблице Excel.Excel - программно получить данные, используемые в диаграмме

Для каждой диаграммы мне необходимо предоставить таблицу данных, содержащую только данные, используемые на этой диаграмме. Поэтому, если в диаграмме A указано 20 точек данных для каждой из 4 категорий, конечный результат, который я хочу, представляет собой таблицу с 20 строками и 4 столбцами - ровно 80 ячеек, точки данных, которые появляются на графике. (Плюс строка и столбец для заголовков серий.)

Как я это делаю сейчас, щелкнув правой кнопкой мыши на диаграмме и используя Select data, чтобы выделить базовую серию. Затем я копирую эту серию в сторону, а затем повторяю, пока не скомпилирую таблицу.

Излишне говорить, что это чрезвычайно трудоемко и очень подвержено человеческой ошибке. Есть ли способ сделать это программно, используя VBA или что-нибудь еще?

+0

Вы пытались сделать это вручную и записать свои действия в виде макроса? Когда я это сделал, я обнаружил, что единственная команда 'ActiveChart.ApplyLayout (5)' сделала много магии. Может быть, что-то подобное сработает для вас? – Floris

+2

Посмотрите методы на объект ['Chart'] (http://msdn.microsoft.com/en-us/library/office/aa213725 (v = office.11) .aspx), в частности' Chart.XValues' , 'Chart.SeriesCollection (i) .XValues' и' Chart.SeriesCollection (i) .YValues'. – Chel

ответ

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 
+0

Чтобы уточнить, могу ли я удалить все строки между 'Debug.Print vbTab & srs.Formula' через комментарий« вряд ли кажется необходимым », если не задействованы формулы? – supertrue

+0

Да, вы можете удалить эти строки. Я привел несколько примеров в этом коде, чтобы показать различные способы доступа к частям данных диаграммы. Эти строки, в частности, скорее всего, не являются методами, которые вы хотели бы использовать. –

+0

@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" 
+2

Кажется, это вовсе не то, о чем попросил ОП, или полная противоположность тому, о чем попросил ОП. Ваш код демонстрирует, как принимать аргументы диапазона в свойствах 'Серии'. OP необходимо перенести свойства и перевести их обратно на рабочий лист (таблицу). –

Смежные вопросы