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''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

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

2 个答案: