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

我需要能够识别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 – 也许这有助于：

 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

您可以使用Findfunction来查找SeriesCollection(1)的值。

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

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

码

 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