Question

我有一个Excel工作簿，在一个选项卡上有一个大数据集，用于多个电感器，另一个选项卡上有大约30个图表，基于这些数据。

我找到了以下帖子

以下代码很棒：

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有点新手，但是其他任何人都可以帮我修改上面的内容来更新多个图表而不是只有一个而在另一个标签中请更新数据吗？

Answer 1

要按名称引用工作表，请使用以下语法：

Worksheets("sheet_name")

如果您想使用工作表变量，以便在代码中多次轻松引用同一工作表，请使用：

Dim mySheet As Worksheet
Set mySheet = Worksheets("sheet_name")

mySheet.Range("A1").Value = "some thing"

每个工作表都有一个ChartObjects集合，您可以在其上进行迭代。

Dim cht As ChartObject

For Each cht In ThisWorkbook.Worksheets("sheet_name").ChartObjects
    Debug.Print cht.Name
Next cht

请注意这些要点，您的代码块应该更改为（警告 - 这是未经测试的）：

For Each oCht In ThisWorkbook.Worksheets("sheet_name").ChartObjects
    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
Next oCht

VBA更新另一个选项卡上的图表

1 个答案: