web-dev-qa-db-ja.com

VBA：グラフのデータ範囲を変更する

私の「グラフデータ範囲」は='sheet1'!$A$1:$Z$10です。 VBAマクロを作成したい（または、誰かが使用できる数式を知っているが、1つを見つけられなかった場合）を実行するたびに、chart1の範囲の終了列を1増やします大きい。だから本質的に：

chart1.endCol = chart1.endCol + 1

ActiveChartを使用してこれの構文は何ですか、またはより良い方法がありますか？

excelvbachartsrange
6
Stuart

（1つの列を追加することにより）範囲を拡大して、ダイアグラム内の各シリーズの観測を1つ追加する（そして新しいシリーズを追加しない）と仮定すると、次のコードを使用できます。

Sub ChangeChartRange()
    Dim i As Integer, r As Integer, n As Integer, p1 As Integer, p2 As Integer, p3 As Integer
    Dim rng As Range
    Dim ax As Range

    'Cycles through each series
    For n = 1 To ActiveChart.SeriesCollection.Count Step 1
        r = 0

        'Finds the current range of the series and the axis
        For i = 1 To Len(ActiveChart.SeriesCollection(n).Formula) Step 1
            If Mid(ActiveChart.SeriesCollection(n).Formula, i, 1) = "," Then
                r = r + 1
                If r = 1 Then p1 = i + 1
                If r = 2 Then p2 = i
                If r = 3 Then p3 = i
            End If
        Next i


        'Defines new range
        Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 + 1, p3 - p2 - 1))
        Set rng = Range(rng, rng.Offset(0, 1))

        'Sets new range for each series
        ActiveChart.SeriesCollection(n).Values = rng

        'Updates axis
        Set ax = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p1, p2 - p1))
        Set ax = Range(ax, ax.Offset(0, 1))
        ActiveChart.SeriesCollection(n).XValues = ax

    Next n
End Sub
4
Netloh

_Offset function_ダイナミックレンジはそれを可能にします。

サンプルデータ

enter image description here

手順

  • 動的な名前付き範囲=OFFSET(Sheet1!$A$2,,,1,COUNTA(Sheet1!$A$2:$Z$2))を定義し、それに名前mobileRangeを付けます
  • チャートを右クリック
  • [データの選択]をクリックします

この画面が表示されます

enter image description here

Legend Entriesの下のEditをクリックします。（mobilesが選択されています）

enter image description here

  • シリーズ値を変更して、mobileRange名前付き範囲を指すようにします。
  • 今後の月のデータがモバイル販売に追加されると、自動的にグラフに反映されます。
6
Santosh

選択したグラフでのみマクロを実行すると仮定すると、私の考えは、各シリーズの数式の範囲を変更することです。ワークシートのすべてのグラフに変更を適用することができます。

更新：スクリーンショットを含む複数のシリーズに対応するようにコードを変更しました

Sub ChartRangeAdd()
    On Error Resume Next
    Dim oCht As Chart, aFormulaOld As Variant, aFormulaNew As Variant
    Dim i As Long, s As Long
    Dim oRng As Range, sTmp As String, sBase As String

    Set oCht = ActiveSheet.ChartObjects(1).Chart
    oCht.Select
    For s = 1 To oCht.SeriesCollection.count
        sTmp = oCht.SeriesCollection(s).Formula
        sBase = Split(sTmp, "(")(0) & "(<FORMULA>)" ' "=SERIES(" & "<FORMULA>)"
        sTmp = Split(sTmp, "(")(1) ' "..., ..., ...)"
        aFormulaOld = Split(Left(sTmp, Len(sTmp) - 1), ",") ' "..., ..., ..."
        aFormulaNew = Array()
        ReDim aFormulaNew(UBound(aFormulaOld))
        ' Process all series in the formula
        For i = 0 To UBound(aFormulaOld)
            Set oRng = Range(aFormulaOld(i))
            ' Attempt to put the value into Range, keep the same if it's not valid Range
            If Err.Number = 0 Then
                Set oRng = oRng.Worksheet.Range(oRng, oRng.Offset(0, 1))
                aFormulaNew(i) = oRng.Worksheet.Name & "!" & oRng.Address
            Else
                aFormulaNew(i) = aFormulaOld(i)
                Err.Clear
            End If
        Next i
        sTmp = Replace(sBase, "<FORMULA>", Join(aFormulaNew, ","))
        Debug.Print "Series(" & s & ") from """ & oCht.SeriesCollection(s).Formula & """ to """ & sTmp & """"
        oCht.SeriesCollection(s).Formula = sTmp
        sTmp = ""
    Next s
    Set oCht = Nothing
End Sub

サンプルデータ-初期

InitialData

最初の実行後：

FirstRun

2回目の実行：

SecondRun

3回目の実行：

ThirdRun

3
PatricK