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

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 e $ ,, t！3！$ ），它将失败。 如果已命名系列1（例如.SeriesCollection(1).Formula = "=SERIES(**"Hell,o !"**,'Sh''ee$,,t!3!$'!$B$2:$B$18,'Sh''ee$,,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