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 E $ ,,トン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

あなたはSeriesCollection(1)の値を探すためにFind機能を使用することができます

で。 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