0

1 つの大きな 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 に答える