Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


12161 / 13646 ツリー ←次へ | 前へ→

【11584】グラフの元データ範囲の取得 Excel大好きちゃん 04/3/11(木) 18:51 質問
【11589】Re:グラフの元データ範囲の取得 ichinose 04/3/12(金) 8:40 発言
【11591】Re:グラフの元データ範囲の取得 Excel大好きちゃん 04/3/12(金) 9:25 お礼
【11594】Re:グラフの元データ範囲の取得 ichinose 04/3/12(金) 9:54 発言
【11597】Re:グラフの元データ範囲の取得 Excel大好きちゃん 04/3/12(金) 10:07 お礼
【11643】Re:グラフの元データ範囲の取得 ichinose 04/3/12(金) 22:40 発言
【11738】Re:グラフの元データ範囲の取得 Excel大好きちゃん 04/3/15(月) 17:23 お礼
【11644】Re:グラフの元データ範囲の取得 Kein 04/3/13(土) 0:01 回答
【11692】Re:グラフの元データ範囲の取得 ichinose 04/3/14(日) 21:41 発言
【11708】Re:グラフの元データ範囲の取得 Excel大好きちゃん 04/3/15(月) 9:46 発言
【11746】Re:グラフの元データ範囲の取得 ichinose 04/3/15(月) 18:36 発言
【11757】Re:グラフの元データ範囲の取得 ichinose 04/3/15(月) 21:57 発言
【11758】Re:グラフの元データ範囲の取得 更に訂正 ichinose 04/3/15(月) 22:22 発言
【12018】気づかなくて、お礼が遅くなりました。(^^♪ Excel大好きちゃん 04/3/22(月) 12:11 お礼
【11739】Re:グラフの元データ範囲の取得 Excel大好きちゃん 04/3/15(月) 17:26 お礼

【11584】グラフの元データ範囲の取得
質問  Excel大好きちゃん  - 04/3/11(木) 18:51 -

引用なし
パスワード
   皆さん、こんにちは。
グラフの元データ範囲の取得は、どうやったらできるのでしょうか。設定については、ActiveChart.SetSourceDataメソッドでできることはわかっていますが、逆の取得方法が不明で、調べてみても私の能力ではNGでした。是非、ご教示お願い致します。

【11589】Re:グラフの元データ範囲の取得
発言  ichinose  - 04/3/12(金) 8:40 -

引用なし
パスワード
   ▼Excel大好きちゃん さん:
おはようございます。

>皆さん、こんにちは。
>グラフの元データ範囲の取得は、どうやったらできるのでしょうか。設定については、ActiveChart.SetSourceDataメソッドでできることはわかっていますが、逆の取得方法が不明で、調べてみても私の能力ではNGでした。是非、ご教示お願い致します。

私は、普段チャートをあまり触らないので、探ってみましたが、元のデータのデータ範囲に相当するプロパティって、見つかりませんでした。
で、SeriesCollectionを調べてセルアドレスをつなげて行く方法です。
簡単なグラフ(データ範囲が同一シート内でないと失敗してしまいます)でしかテストしていませんが、確認してみて下さい。
コードは、埋め込みグラフでの例です。

'===========================================================
Sub test()
  Dim cht As Chart
  Dim srs As Series
  Dim rng As Range
  Dim r_add As String
  Set cht = ActiveSheet.ChartObjects(1).Chart
  Set rng = Nothing
  For Each srs In cht.SeriesCollection
    r_add = edit_addr(srs.Formula, srs.PlotOrder)
    If r_add <> "" Then
      If rng Is Nothing Then
       Set rng = Range(r_add)
      Else
       Set rng = Union(rng, Range(r_add))
       End If
      End If
    Next
  If Not rng Is Nothing Then
    MsgBox rng.Address
    End If
End Sub
'=================================================================
Function edit_addr(add, podr As Long) As String
  Dim ans()
  wk = Split(Replace$(Replace$(add, "=SERIES(", ""), "," & podr & ")", ""), ",")
  jdx = 1
  For idx = LBound(wk) To UBound(wk)
   If wk(idx) <> "" Then
    ReDim Preserve ans(1 To jdx)
    ans(jdx) = wk(idx)
    jdx = jdx + 1
    End If
   Next
  If jdx > 1 Then
   edit_addr = Join(ans(), ",")
  Else
   edit_addr = ""
   End If
End Function

【11591】Re:グラフの元データ範囲の取得
お礼  Excel大好きちゃん  - 04/3/12(金) 9:25 -

引用なし
パスワード
   ichinose さん
おはようございますー(~_~)

早速のご教示、ありがとうございます。
今、頂いたコードを埋め込みグラフの存在するシートをアクティブにして実行してみたのですが、
Set rng = Union(rng, Range(r_add))
のところで、メソッド失敗というエラーが出て、止まってしまいました。
やり方が悪いのでしょうか?
どうもすみませんー


>▼Excel大好きちゃん さん:
>おはようございます。
>
>>皆さん、こんにちは。
>>グラフの元データ範囲の取得は、どうやったらできるのでしょうか。設定については、ActiveChart.SetSourceDataメソッドでできることはわかっていますが、逆の取得方法が不明で、調べてみても私の能力ではNGでした。是非、ご教示お願い致します。
>
>私は、普段チャートをあまり触らないので、探ってみましたが、元のデータのデータ範囲に相当するプロパティって、見つかりませんでした。
>で、SeriesCollectionを調べてセルアドレスをつなげて行く方法です。
>簡単なグラフ(データ範囲が同一シート内でないと失敗してしまいます)でしかテストしていませんが、確認してみて下さい。
>コードは、埋め込みグラフでの例です。
>
>'===========================================================
>Sub test()
>  Dim cht As Chart
>  Dim srs As Series
>  Dim rng As Range
>  Dim r_add As String
>  Set cht = ActiveSheet.ChartObjects(1).Chart
>  Set rng = Nothing
>  For Each srs In cht.SeriesCollection
>    r_add = edit_addr(srs.Formula, srs.PlotOrder)
>    If r_add <> "" Then
>      If rng Is Nothing Then
>       Set rng = Range(r_add)
>      Else
>       Set rng = Union(rng, Range(r_add))
>       End If
>      End If
>    Next
>  If Not rng Is Nothing Then
>    MsgBox rng.Address
>    End If
>End Sub
>'=================================================================
>Function edit_addr(add, podr As Long) As String
>  Dim ans()
>  wk = Split(Replace$(Replace$(add, "=SERIES(", ""), "," & podr & ")", ""), ",")
>  jdx = 1
>  For idx = LBound(wk) To UBound(wk)
>   If wk(idx) <> "" Then
>    ReDim Preserve ans(1 To jdx)
>    ans(jdx) = wk(idx)
>    jdx = jdx + 1
>    End If
>   Next
>  If jdx > 1 Then
>   edit_addr = Join(ans(), ",")
>  Else
>   edit_addr = ""
>   End If
>End Function

【11594】Re:グラフの元データ範囲の取得
発言  ichinose  - 04/3/12(金) 9:54 -

引用なし
パスワード
   ▼Excel大好きちゃん さん:

>
>早速のご教示、ありがとうございます。
>今、頂いたコードを埋め込みグラフの存在するシートをアクティブにして実行してみたのですが、
>Set rng = Union(rng, Range(r_add))
>のところで、メソッド失敗というエラーが出て、止まってしまいました。
>やり方が悪いのでしょうか?
>どうもすみませんー
あららー、そうですか?edit_addrに問題があるのでしょう・・。
私の検証不足です。

お手数ですが、プロシジャーTestだけ以下のコードに変えて
イミディエイトウインドウにどういうふうに表示されているか教えて下さい。
私もこの辺触るの初めてなので、勉強させて下さい。

>>'===========================================================
>>Sub test()
>>  Dim cht As Chart
>>  Dim srs As Series
>>  Dim rng As Range
>>  Dim r_add As String
>>  Set cht = ActiveSheet.ChartObjects(1).Chart
>>  Set rng = Nothing
>>  For Each srs In cht.SeriesCollection
>>    r_add = edit_addr(srs.Formula, srs.PlotOrder)
>>    If r_add <> "" Then
      debug.print srs.formula & "---" & r_add

>>      End If
>>    Next
'  If Not rng Is Nothing Then この辺、取りあえずコメント
'    MsgBox rng.Address
'    End If
>>End Sub
>>'=================================================================
>>Function edit_addr(add, podr As Long) As String
>>  Dim ans()
>>  wk = Split(Replace$(Replace$(add, "=SERIES(", ""), "," & podr & ")", ""), ",")
>>  jdx = 1
>>  For idx = LBound(wk) To UBound(wk)
>>   If wk(idx) <> "" Then
>>    ReDim Preserve ans(1 To jdx)
>>    ans(jdx) = wk(idx)
>>    jdx = jdx + 1
>>    End If
>>   Next
>>  If jdx > 1 Then
>>   edit_addr = Join(ans(), ",")
>>  Else
>>   edit_addr = ""
>>   End If
>>End Function


それから、同じような質問が過去ログにもありました。

http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=ntr;tree=10832;id=Excel

私が確認していませんが、参考にして下さい。


それとこの後の返信が本日の夜か又は、明日になってしまいます。
ごめんなさい。

【11597】Re:グラフの元データ範囲の取得
お礼  Excel大好きちゃん  - 04/3/12(金) 10:07 -

引用なし
パスワード
   ichinose さん:

再びのレス、ありがとうございます。
コードを差し替えて実行してみたのですが、
エラーは出なくなりましたけど、何も表示されません。
debug.print
のところがミソなのでしょうか。わたしが素人なもので。。。
エーーーン
そこで、最初に頂いたコードで、エラーが出るところを
コメントに変更して実行してみましたら、
うまく「元データを取得できました。」(~_~)
これからまた、いろいろ 試してみたいと思います。
お忙しいのに ご親切にして下さってどうも、ありがとうございました。

>▼Excel大好きちゃん さん:
>
>>
>>早速のご教示、ありがとうございます。
>>今、頂いたコードを埋め込みグラフの存在するシートをアクティブにして実行してみたのですが、
>>Set rng = Union(rng, Range(r_add))
>>のところで、メソッド失敗というエラーが出て、止まってしまいました。
>>やり方が悪いのでしょうか?
>>どうもすみませんー
>あららー、そうですか?edit_addrに問題があるのでしょう・・。
>私の検証不足です。
>
>お手数ですが、プロシジャーTestだけ以下のコードに変えて
>イミディエイトウインドウにどういうふうに表示されているか教えて下さい。
>私もこの辺触るの初めてなので、勉強させて下さい。
>
>>>'===========================================================
>>>Sub test()
>>>  Dim cht As Chart
>>>  Dim srs As Series
>>>  Dim rng As Range
>>>  Dim r_add As String
>>>  Set cht = ActiveSheet.ChartObjects(1).Chart
>>>  Set rng = Nothing
>>>  For Each srs In cht.SeriesCollection
>>>    r_add = edit_addr(srs.Formula, srs.PlotOrder)
>>>    If r_add <> "" Then
>      debug.print srs.formula & "---" & r_add
>
>>>      End If
>>>    Next
>'  If Not rng Is Nothing Then この辺、取りあえずコメント
>'    MsgBox rng.Address
>'    End If
>>>End Sub
>>>'=================================================================
>>>Function edit_addr(add, podr As Long) As String
>>>  Dim ans()
>>>  wk = Split(Replace$(Replace$(add, "=SERIES(", ""), "," & podr & ")", ""), ",")
>>>  jdx = 1
>>>  For idx = LBound(wk) To UBound(wk)
>>>   If wk(idx) <> "" Then
>>>    ReDim Preserve ans(1 To jdx)
>>>    ans(jdx) = wk(idx)
>>>    jdx = jdx + 1
>>>    End If
>>>   Next
>>>  If jdx > 1 Then
>>>   edit_addr = Join(ans(), ",")
>>>  Else
>>>   edit_addr = ""
>>>   End If
>>>End Function
>
>
>それから、同じような質問が過去ログにもありました。
>
>http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=ntr;tree=10832;id=Excel
>
>私が確認していませんが、参考にして下さい。
>
>
>それとこの後の返信が本日の夜か又は、明日になってしまいます。
>ごめんなさい。

【11643】Re:グラフの元データ範囲の取得
発言  ichinose  - 04/3/12(金) 22:40 -

引用なし
パスワード
   ▼Excel大好きちゃん さん:
こんばんは。

>再びのレス、ありがとうございます。
>コードを差し替えて実行してみたのですが、
>エラーは出なくなりましたけど、何も表示されません。
>debug.print
>のところがミソなのでしょうか。わたしが素人なもので。。。
>エーーーン
あー、そうですよね、「debug.print」なんて私も勉強し始めてかなり経ってから
使い出したんだっけ!!

ちなみに
VBE(Visual Basic Editor)を開いて(これはコードを実行させておられるのでOKですよね)、Ctrl+Gで表示されるのが「イミディエイトウインドウ」です。
ここに、
>>      debug.print srs.formula & "---" & r_add
の内容が表示されるんです。
コードの途中結果等が正しいか否かをチェックするときには、便利ですよ!!


>そこで、最初に頂いたコードで、エラーが出るところを
>コメントに変更して実行してみましたら、
>うまく「元データを取得できました。」(~_~)
なるほど・・・。
これは、データ範囲の領域の数がひとつのグラフですよね!!
例えば、アクティブシートのA列1行目から

     A    B    C     D
1    x    y        z
2    1    20        20
3    2    40        40
4    3    80        80
5    4    160        160
6    5    320        320
7    6    640        640
8    7    1280        1280
9    8    2560        2560
10    9    5120        5120

上記のセルA1からB10、さらにD1からD10をデータ範囲としてグラフ作成した場合も
何とかできないかなあ と思い、

>  Set rng = Union(rng, Range(r_add))

というコードを記述したんですが・・・。

取りあえず、気になった箇所を修正しました。
でも、色々試してみるとやっぱり完全には取得は難しいですが・・。

'============================================================
Sub test()
  Dim cht As Chart
  Dim srs As Series
  Dim rng As Range
  Dim r_add As String
  Set cht = ActiveSheet.ChartObjects(1).Chart
  Set rng = Nothing
  For Each srs In cht.SeriesCollection
    r_add = edit_addr(srs.Formula, srs.PlotOrder)
    If r_add <> "" Then
      If rng Is Nothing Then
       Set rng = Range(r_add)
      Else
       Set rng = Union(rng, Range(r_add))
       End If
      End If
    Next
  If Not rng Is Nothing Then
    MsgBox rng.Address(, , , True)
    End If
End Sub
'=================================================================
Function edit_addr(add, podr As Long) As String
  Dim ans()
  wk = Split(Replace$(Replace$(add, "=SERIES(", ""), "," & podr & ")", ""), ",")
  jdx = 1
  For idx = LBound(wk) To UBound(wk)
   If TypeName(Application.Evaluate(wk(idx))) = "Range" Then
    ReDim Preserve ans(1 To jdx)
    ans(jdx) = wk(idx)
    jdx = jdx + 1
    End If
   Next
  If jdx > 1 Then
   edit_addr = Join(ans(), ",")
  Else
   edit_addr = ""
   End If
End Function

もし、ご覧になられていたら再度、確認してみて下さい。

このご質問で色々と確認する事ができました。

【11644】Re:グラフの元データ範囲の取得
回答  Kein  - 04/3/13(土) 0:01 -

引用なし
パスワード
   系列から数式を取得し、カンマ区切りで分解するという方法は良いと思います。
ただ、拝見したような複雑なコードが必要なのかは分かりません。
もし既存のグラフに、コピー&ペーストでデータを繰り返し追加していたら、
SERIES関数の数式がヘンな形になってしまうのは知ってますが、そのようなプロット
範囲の拡大方法をしていないなら、最も単純な 4つの引数を持つ数式であるはず
です。即ち

=SERIES(系列名の文字列またはその参照, 項目軸範囲, 数値軸範囲, 系列のIndex)

ですから単純に

Dim SR As Series
Dim SeriAry As Variant
Dim x As Integer
Dim ShN As String, PltAd As String

Set SR = ActiveChart.SeriesCollection(1)
SeriAry = Split(SR.Formula, ",")
x = InStr(1, SeriAry(2), "!")
ShN = Left$(SeriAry(2), x - 1)
PltAd = Right$(SeriAry(2), Len(SeriAry) - x)

と文字列を抜き出して

Worksheets(ShN).Range(PltAd)

をプロットしているデータ範囲、とすればよいと思います。

【11692】Re:グラフの元データ範囲の取得
発言  ichinose  - 04/3/14(日) 21:41 -

引用なし
パスワード
   ▼Kein さん:
こんばんは。いつも参考させて頂いています。

>系列から数式を取得し、カンマ区切りで分解するという方法は良いと思います。
>ただ、拝見したような複雑なコードが必要なのかは分かりません。
>もし既存のグラフに、コピー&ペーストでデータを繰り返し追加していたら、
>SERIES関数の数式がヘンな形になってしまうのは知ってますが、そのようなプロット
>範囲の拡大方法をしていないなら、最も単純な 4つの引数を持つ数式であるはず
>です。即ち
>
>=SERIES(系列名の文字列またはその参照, 項目軸範囲, 数値軸範囲, 系列のIndex)


まず、私が投稿させていただいたコードは、Excel大好きちゃんさんの質問内容から
Seriesオブジェクトのformulaプロパティから取得できるセル参照アドレスを
全て取得するのが目的でした。

投稿コードの例は、グラフが参照しているセルは、全て同一シート内と限定させて頂きました(理由は、Unionメソッドで結果をまとめたかったから・・、私の方の都合です)。
 
>=SERIES(系列名の文字列またはその参照, 項目軸範囲, 数値軸範囲, 系列のIndex)
 
これは、体系化されたマニュアルやサイトを確認したわけではありませんが、
いくつかのグラフをサンプリングした結果、私もそうなのだろうという予想はしていました。でも、Keinさんに改めてご提示して頂いて確信できました。感謝です。
 
>ただ、拝見したような複雑なコードが必要なのかは分かりません。
私は、都合よく将来活用するためには、これではまだ足りないと思っていたんですが・・。

上述したような仕様から、例えば、Seriesオブジェクトのformulaプロパティの内容は、

「=SERIES(Sheet1!$B$1,Sheet1!$A$2:$A$10,{20,30,40,50,60,70,80,90,100},1)」

等の場合も想定しています。
つまり、数値軸範囲として、配列値が入ってしまう場合です。

提示させていただいたコードで今のところこれも正しく取得してくれています。

実際には、ただせる範囲を集めるのではなく、このFormulaプロパティを解析して、

系列名の文字列またはその参照 として、 結果1
項目軸範囲 として、          結果2
数値軸範囲 として、          結果3

というようにセル範囲を識別できるようにしなければいけないかなあ
と思っています。

【11708】Re:グラフの元データ範囲の取得
発言  Excel大好きちゃん  - 04/3/15(月) 9:46 -

引用なし
パスワード
   ▼ichinose さん:
▼Kein さん:
どうも、ありがとうございます。
レスが遅くなって申し訳ございません。
わたしのPCは、会社からですので、土日は見れないんです。m(__)m
お二人のご助言を頼りに、今週また時間を見つけて
いろいろ試してみますね。(^^♪

ところで、わたしが、最終的にやりたかったことなんですが、
アクティブブックが他のブックを外部参照している場合に、そのセルや
オブジェクトを見つけ出して知らせてくれるマクロなんです。
わたしが作ったブックを上のひとや、他部門のひとに渡す場合に
その辺のチェックを手軽にかけたいな、ということなんです。
そのときに、グラフについては、その元データのセル範囲を
取得して、外部参照なのかどうかをチェックしようと思ったんです。
ところが、わたしの力では、このセル範囲取得ができませんでしたので
思い切って ここに投稿させて頂きました。
本当に、ありがとうございます。
実は、この「ブックの外部参照」を別の方法でうまく見つける方法が
あるのかも ですねー
どっちにしてもわたしには全然歯が立たないのですけれど。。。(^_^.)

【11738】Re:グラフの元データ範囲の取得
お礼  Excel大好きちゃん  - 04/3/15(月) 17:23 -

引用なし
パスワード
   ▼ichinose さん:

ありがとうございます。
今、頂いたコードを実行してみました。
普通の埋め込みグラフだと、OKでしたが、
データ範囲が複雑な場合や外部参照の場合がNGでした。
でも、これは仕方ないですよね。
どうも、ありがとうございました。 (^^♪


>こんばんは。
>
>>再びのレス、ありがとうございます。
>>コードを差し替えて実行してみたのですが、
>>エラーは出なくなりましたけど、何も表示されません。
>>debug.print
>>のところがミソなのでしょうか。わたしが素人なもので。。。
>>エーーーン
>あー、そうですよね、「debug.print」なんて私も勉強し始めてかなり経ってから
>使い出したんだっけ!!
>
>ちなみに
>VBE(Visual Basic Editor)を開いて(これはコードを実行させておられるのでOKですよね)、Ctrl+Gで表示されるのが「イミディエイトウインドウ」です。
>ここに、
>>>      debug.print srs.formula & "---" & r_add
>の内容が表示されるんです。
>コードの途中結果等が正しいか否かをチェックするときには、便利ですよ!!
>
>
>>そこで、最初に頂いたコードで、エラーが出るところを
>>コメントに変更して実行してみましたら、
>>うまく「元データを取得できました。」(~_~)
>なるほど・・・。
>これは、データ範囲の領域の数がひとつのグラフですよね!!
>例えば、アクティブシートのA列1行目から
>
>     A    B    C     D
>1    x    y        z
>2    1    20        20
>3    2    40        40
>4    3    80        80
>5    4    160        160
>6    5    320        320
>7    6    640        640
>8    7    1280        1280
>9    8    2560        2560
>10    9    5120        5120
>
>上記のセルA1からB10、さらにD1からD10をデータ範囲としてグラフ作成した場合も
>何とかできないかなあ と思い、
>
>>  Set rng = Union(rng, Range(r_add))
>
>というコードを記述したんですが・・・。
>
>取りあえず、気になった箇所を修正しました。
>でも、色々試してみるとやっぱり完全には取得は難しいですが・・。
>
>'============================================================
>Sub test()
>  Dim cht As Chart
>  Dim srs As Series
>  Dim rng As Range
>  Dim r_add As String
>  Set cht = ActiveSheet.ChartObjects(1).Chart
>  Set rng = Nothing
>  For Each srs In cht.SeriesCollection
>    r_add = edit_addr(srs.Formula, srs.PlotOrder)
>    If r_add <> "" Then
>      If rng Is Nothing Then
>       Set rng = Range(r_add)
>      Else
>       Set rng = Union(rng, Range(r_add))
>       End If
>      End If
>    Next
>  If Not rng Is Nothing Then
>    MsgBox rng.Address(, , , True)
>    End If
>End Sub
>'=================================================================
>Function edit_addr(add, podr As Long) As String
>  Dim ans()
>  wk = Split(Replace$(Replace$(add, "=SERIES(", ""), "," & podr & ")", ""), ",")
>  jdx = 1
>  For idx = LBound(wk) To UBound(wk)
>   If TypeName(Application.Evaluate(wk(idx))) = "Range" Then
>    ReDim Preserve ans(1 To jdx)
>    ans(jdx) = wk(idx)
>    jdx = jdx + 1
>    End If
>   Next
>  If jdx > 1 Then
>   edit_addr = Join(ans(), ",")
>  Else
>   edit_addr = ""
>   End If
>End Function
>
>もし、ご覧になられていたら再度、確認してみて下さい。
>
>このご質問で色々と確認する事ができました。

【11739】Re:グラフの元データ範囲の取得
お礼  Excel大好きちゃん  - 04/3/15(月) 17:26 -

引用なし
パスワード
   ▼Kein さん:

ありがとうございます。
今、頂いたコードを実行してみました。
わたしのやり方がおかしいのか、途中でエラーで止まって
しまいました。変数の型があっていない、という メッセージです。
グラフをアクティブにしておいて
実行するんですよね?

お手を煩わしてばかりでごめんなさい。
どうも、ありがとうございました。 (^^♪

>系列から数式を取得し、カンマ区切りで分解するという方法は良いと思います。
>ただ、拝見したような複雑なコードが必要なのかは分かりません。
>もし既存のグラフに、コピー&ペーストでデータを繰り返し追加していたら、
>SERIES関数の数式がヘンな形になってしまうのは知ってますが、そのようなプロット
>範囲の拡大方法をしていないなら、最も単純な 4つの引数を持つ数式であるはず
>です。即ち
>
>=SERIES(系列名の文字列またはその参照, 項目軸範囲, 数値軸範囲, 系列のIndex)
>
>ですから単純に
>
>Dim SR As Series
>Dim SeriAry As Variant
>Dim x As Integer
>Dim ShN As String, PltAd As String
>
>Set SR = ActiveChart.SeriesCollection(1)
>SeriAry = Split(SR.Formula, ",")
>x = InStr(1, SeriAry(2), "!")
>ShN = Left$(SeriAry(2), x - 1)
>PltAd = Right$(SeriAry(2), Len(SeriAry) - x)
>
>と文字列を抜き出して
>
>Worksheets(ShN).Range(PltAd)
>
>をプロットしているデータ範囲、とすればよいと思います。

【11746】Re:グラフの元データ範囲の取得
発言  ichinose  - 04/3/15(月) 18:36 -

引用なし
パスワード
   ▼Excel大好きちゃん さん:
こんばんは。
>そのときに、グラフについては、その元データのセル範囲を
>取得して、外部参照なのかどうかをチェックしようと思ったんです。
違うシートどころか外部参照もあるんですね!!
作ってみましたので、確認して下さい。
仕様は、参照しているセルアドレス(外部参照を含む)を新規ブックを作成し、その最左端シートのA列に
記述します。
リンク切れの場合もかまわず、取得します。
'==========================================================
Dim regEx, Match, Matches
'==========================================================
Sub test()
  Dim cht As Chart
  Dim srs As Series
  Dim rng As Range
  Dim r_add
  Set regEx = CreateObject("VBScript.RegExp")
  Set cht = ActiveSheet.ChartObjects(1).Chart
  Set rng = Nothing
  Set bk = Workbooks.add
  jdx = 1
  For Each srs In cht.SeriesCollection
    r_add = edit_addr(srs.Formula, srs.PlotOrder)
    If VarType(r_add) >= vbArray Then
      For idx = LBound(r_add) To UBound(r_add)
       bk.Worksheets(1).Cells(jdx, 1).Value = r_add(idx)
       jdx = jdx + 1
       Next
      End If
    Next
  Set regEx = Nothing
End Sub
'=================================================================
Function edit_addr(add, podr As Long)
  Dim ans()
  Dim o_str
  wk = Split(Replace$(Replace$(add, "=SERIES(", ""), "," & podr & ")", ""), ",")
  jdx = 1
  For idx = LBound(wk) To UBound(wk)
   Select Case TypeName(Application.Evaluate(wk(idx)))
     Case "Range"
      ReDim Preserve ans(1 To jdx)
      ans(jdx) = wk(idx)
      jdx = jdx + 1
     Case "Error"
      If get_reg_match(wk(idx), "'.*\[.*\].+'!", o_str) = 0 Then
       o_str1 = o_str
       o_str2 = Replace$(wk(idx), o_str, "")
       If TypeName(Application.Evaluate(o_str2)) = "Range" Then
         If o_str1 & o_str2 = wk(idx) Then
          ReDim Preserve ans(1 To jdx)
          ans(jdx) = wk(idx)
          jdx = jdx + 1
          End If
         End If
       End If
     End Select
   Next
  If jdx > 1 Then
   edit_addr = ans()
  Else
   edit_addr = ""
   End If
End Function
'=============================================================
Function get_reg_match(chk_str, P_string, o_string) As Long
  regEx.Pattern = P_string
  get_reg_match = 1
  regEx.IgnoreCase = True
  regEx.Global = True
  Set Matches = regEx.Execute(chk_str)
  If Matches.Count = 1 Then
   o_string = Matches(0).Value
   get_reg_match = 0
   End If
End Function

で、testを実行してみて下さい。

【11757】Re:グラフの元データ範囲の取得
発言  ichinose  - 04/3/15(月) 21:57 -

引用なし
パスワード
   >こんばんは。
>>そのときに、グラフについては、その元データのセル範囲を
>>取得して、外部参照なのかどうかをチェックしようと思ったんです。
>違うシートどころか外部参照もあるんですね!!
>作ってみましたので、確認して下さい。
>仕様は、参照しているセルアドレス(外部参照を含む)を新規ブックを作成し、その最左端シートのA列に
>記述します。
>リンク切れの場合もかまわず、取得します。
>'==========================================================
>Dim regEx, Match, Matches
>'==========================================================
>Sub test()
>  Dim cht As Chart
>  Dim srs As Series
>  Dim rng As Range
>  Dim r_add
>  Set regEx = CreateObject("VBScript.RegExp")
>  Set cht = ActiveSheet.ChartObjects(1).Chart
>  Set rng = Nothing
>  Set bk = Workbooks.add
   bk.Windows(1).Visible = false
>  jdx = 1
>  For Each srs In cht.SeriesCollection
>    r_add = edit_addr(srs.Formula, srs.PlotOrder)
>    If VarType(r_add) >= vbArray Then
>      For idx = LBound(r_add) To UBound(r_add)
>       bk.Worksheets(1).Cells(jdx, 1).Value = r_add(idx)
>       jdx = jdx + 1
>       Next
>      End If
>    Next
>  Set regEx = Nothing
   bk.Windows(1).Visible = true
>End Sub
修正してください

【11758】Re:グラフの元データ範囲の取得 更に訂正
発言  ichinose  - 04/3/15(月) 22:22 -

引用なし
パスワード
   >>こんばんは。
>>>そのときに、グラフについては、その元データのセル範囲を
>>>取得して、外部参照なのかどうかをチェックしようと思ったんです。
>>違うシートどころか外部参照もあるんですね!!
>>作ってみましたので、確認して下さい。
>>仕様は、参照しているセルアドレス(外部参照を含む)を新規ブックを作成し、その最左端シートのA列に
>>記述します。
>>リンク切れの場合もかまわず、取得します。
>>'==========================================================
>>Dim regEx, Match, Matches
>>'==========================================================
>>Sub test()
>>  Dim cht As Chart
>>  Dim srs As Series
>>  Dim rng As Range
>>  Dim r_add
>>  Set regEx = CreateObject("VBScript.RegExp")
>>  Set cht = ActiveSheet.ChartObjects(1).Chart
>>  Set rng = Nothing
>>  Set bk = Workbooks.add
>   bk.Windows(1).Visible = false
   thisworkbook.activate
>>  jdx = 1
>>  For Each srs In cht.SeriesCollection
>>    r_add = edit_addr(srs.Formula, srs.PlotOrder)
>>    If VarType(r_add) >= vbArray Then
>>      For idx = LBound(r_add) To UBound(r_add)
>>       bk.Worksheets(1).Cells(jdx, 1).Value = r_add(idx)
>>       jdx = jdx + 1
>>       Next
>>      End If
>>    Next
>>  Set regEx = Nothing
>   bk.Windows(1).Visible = true
>>End Sub
>修正してください

【12018】気づかなくて、お礼が遅くなりました。(...
お礼  Excel大好きちゃん  - 04/3/22(月) 12:11 -

引用なし
パスワード
   ▼ichinose さん:
すみません。
折角改良版コードを送って頂いたのに、全然気づかなくて、確認とお礼が遅くなりました。(^^♪
早速、頂いたコードで実行してみました。
結果は、「Good!!」です。
これで、わたしが やってみたいことができるようになりそうです。
貴重なお時間を割いて頂き、またご親切にして頂き、
本当にありがとうございました。 (^^♪
また、何かのおりにお世話になるかと思いますが、
その節はどうぞ、よろしくお願い致します。

12161 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free