返回 Excel 图表使用 VBA 引用的工作表

Question

我需要能够识别 Excel 图表（在工作表上）从中获取数据的工作表。我只需要系列 1 引用的数据表。我已经开始尝试从 .SeriesCollection(1).Formula 中提取工作表名称，但它变得非常复杂。这是我到目前为止所得到的：

Sub GetChartDataSheet()

Dim DataSheetName As String
Dim DataSheet As Worksheet

DataSheetName = ActiveChart.SeriesCollection(1).Formula

DataSheetName = Left(DataSheetName, InStr(1, DataSheetName, "!$") - 1)
DataSheetName = WorksheetFunction.Replace(DataSheetName, 1, Len("=series("), "")
If Left(DataSheetName, 1) = "'" And Right(DataSheetName, 1) = "'" Then DataSheetName = Mid(DataSheetName, 2, Len(DataSheetName) - 2)
DataSheetName = Replace(DataSheetName, "''", "'")

Set DataSheet = Sheets(DataSheetName)    

End Sub

这在很多情况下都有效，但如果我的用户有一个奇怪的工作表名称（例如 Sh'e$,,t!3!$），它就会失败。如果系列 1 已命名（例如 .SeriesCollection(1).Formula = "=SERIES(**"Hell,o !"**,'Sh''e e$,,t!3!$'!$B$2:$B$18,'Sh''e e$,,t!3!$'!$C$2:$C$18,1)"。

有没有简单的方法来解决这个问题？

Answer 1

我以为这很容易，但事实并非如此。 Excel 拥有信息但不会免费提供的情况之一。我最终得到了这样的功能 - 也许这会有所帮助：

Function getSheetNameOfSeries(s As Series) As String

Dim f As String, i As Integer
Dim withQuotes As Boolean

' Skip leading comma if not all parts of series is filled. Check if sheetname is in single quotes
For i = 9 To Len(s.Formula)
    If Mid(s.Formula, i, 1) <> "," Then
        If Mid(s.Formula, i, 1) = "'" Then
            withQuotes = True
            f = Mid(s.Formula, i + 1)
        Else
            withQuotes = False
            f = Mid(s.Formula, i)
        End If
        Exit For
    End If
Next i

' "f" now contains a part of the formula with the sheetname as start
' now we search to the end of the sheet name.
' If name is in quotes, we are looking for the "closing" quote
' If not in quotes, we are looking for "!"
i = 1
Do While True

    If withQuotes Then
        ' Sheet name is in quotes, found closes quote --> we're done
        ' (but if next char is also a quote, we have the case the the sheet names contains a quote, so we have to continue working)
        If Mid(f, i, 1) = "'" Then
            If Mid(f, i + 1, 1) <> "'" Then
                getSheetNameOfSeries = Mid(f, 1, i - 1)
                Exit Do
            Else
                i = i + 1       ' Skip 2nd quote
            End If
        End If
    Else
        ' Sheet name is quite normal, so "!" will indicate the end of sheetname
        If Mid(f, i, 1) = "!" Then
            getSheetNameOfSeries = Mid(f, 1, i - 1)
            Exit Do
        End If
    End If

    i = i + 1
Loop

getSheetNameOfSeries = Replace(getSheetNameOfSeries, "''", "'")

End Function

Answer 2

您可以使用Find 函数来查找SeriesCollection(1) 的值。

在保存SeriesCollection(1) 数据的工作表中，您将能够找到该数组中的所有值。

下面的代码中有更多解释。

代码

Option Explicit

Sub GetChartDataSheet()

Dim DataSheetName As String
Dim DataSheet As Worksheet
Dim ws As Worksheet
Dim ValuesArr As Variant, Val As Variant
Dim FindRng As Range
Dim ShtMatch As Boolean

Dim ChtObj As ChartObject
Dim Ser As Series

' if you want to use ActiveChart
Set ChtObj = ActiveChart.Parent

Set Ser = ChtObj.Chart.SeriesCollection(1)
ValuesArr = Ser.Values ' get the values of the Series Collection inside an array

' use Find to get the Sheet's origin
For Each ws In ThisWorkbook.Sheets
    With ws
        ShtMatch = True
        For Each Val In ValuesArr ' loop through all values in array
            Set FindRng = .Cells.Find(what:=Val) ' you need to find each value in the worksheet that SeriesCollection data is tied to
            If FindRng Is Nothing Then
                ShtMatch = False
                Exit For
            End If
            Set FindRng = Nothing ' reset
        Next Val

        If ShtMatch = True Then
            Set DataSheet = ws
            Exit For
        End If
    End With
Next ws
DataSheetName = DataSheet.Name

End Sub