Изменить диапазон графика с VBA - PullRequest
0 голосов
/ 29 июня 2018

Я хочу перемещать диапазон диаграммы на один столбец вправо при каждом запуске кода. Таким образом, минимальный диапазон перемещается на один вправо, а максимальный - на то же самое.

Пример: У меня есть график продаж за последние 6 недель в ячейке P13-U13, я хочу видеть данные только за 6 недель, поэтому, когда я добавляю новую седьмую неделю, график должен показывать данные в ячейке Q13-V13. (Всего 6 недель)

Я нашел этот код, который добавляет один дополнительный столбец к диаграмме при каждом запуске. То есть, когда он запускается первый раз, он показывает неделю 1-7, время звучания 1-8, следующие 1-9, и я хотел бы, чтобы он показывал 2-7, 3-8, 4-9 и т. Д. Моя идея состоит в том, чтобы изменить код так, чтобы левая сторона также перемещалась вправо. Но я пока не смог заставить его работать.

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

(ССЫЛКА: VBA: изменить диапазон данных диаграммы )

Спасибо!

...