みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBA(excel)でグラフのデータ範囲の取得

excel2010の
VBA利用者です。

グラフが書いてあって(種類は3D等高線グラフ)、
その元になるデータ範囲は
例えば
ActiveChart.SetSourceData Source:=Range("Sheet1!$A$1:$D$10")
のようにすれば、シート1のRange("A1:D10")の範囲が設定できます。
 では、
 これの 逆に
設定でなくて、取得が出来ませんでしょうか?
 つまり
上記の場合でしたら、範囲"A1:D10"を取得して、変数に代入したいのです。

もし、範囲としての取得が難しいならば、最低限
グラフの現在のデータ範囲の矩形範囲の縦横の、行数、列数の
取得だけでもなんとかしたいのですが、
何か方法はないでしょうか?

縦横数百セルの大き目の範囲を相手にしたいので、
Formulaプロパティで系列ごとに取得していく方法では煩雑になるので
何とかもっと
簡便な方法が無いものかと思っております

御教授のほど、よろしくお願いいたします。

投稿日時 - 2013-05-22 19:31:36

QNo.8100242

すぐに回答ほしいです

質問者が選んだベストアンサー

Sub test()
  Dim filed() As String
  Dim ret()  As String
  Dim v()   As String
  Dim s()   As String
  Dim cnt   As Long
  Dim cx   As Long
  Dim ub   As Long
  Dim n    As Long
  Dim i    As Long
  Dim j    As Long
  Dim k    As Long
  Dim buf

  If ActiveChart Is Nothing Then
    MsgBox "グラフを選択して実行"
    Exit Sub
  End If

  '項目名セット
  filed() = Split("name category_labels values order size")
  With ActiveChart
    'BubbleChartの時
    If (.ChartType = xlBubble) Or (.ChartType = xlBubble3DEffect) Then
      cx = 4
    Else
      cx = 3
    End If

    'アドレス文字格納配列サイズ決定
    cnt = .SeriesCollection.Count
    ReDim ret(0 To cnt, 0 To cx)
    For i = 0 To cx
      ret(0, i) = filed(i)
    Next

    '系列をLoop
    For i = 1 To cnt
      v = Split(.SeriesCollection(i).Formula, ",")
      ub = UBound(v)
      '右端の")"を除外
      v(ub) = Left$(v(ub), Len(v(ub)) - 1)
      '左端の"=SERIES("除外
      ret(i, 0) = Mid$(v(0), 9)
      n = 1
      For j = 1 To cx
        '隔範囲のアドレスを考慮
        If Left$(v(n), 1) = "(" Then
          ReDim s(1 To ub) As String
          For k = 1 To ub
            s(k) = v(n)
            n = n + 1
            If Right$(s(k), 1) = ")" Then Exit For
          Next
          ReDim Preserve s(1 To k)
          ret(i, j) = Join(s, ",")
        Else
          ret(i, j) = v(n)
          n = n + 1
        End If
      Next
      buf = Application.Index(ret, i + 1, 0)
      Debug.Print "系列 " & i, Join(buf, ",")
    Next
  End With
  '新規シートに書き出す時。
  'Sheets.Add.Range("A1").Resize(cnt + 1, cx + 1).Value = ret
  Erase s, ret
End Sub

こんな感じのは昔書いたことありますが
とにかくデータ範囲をRangeに取得するだけなら
Formula文字列を整理すれば簡単そう。

Sub try2()
  Dim r As Range

  If Not ActiveChart Is Nothing Then
    Call GetChartSourceRange(ActiveChart, r)
    Application.Goto r
    MsgBox r.Address(external:=True)
  End If
End Sub
'-----------------------------------------------------------
Sub GetChartSourceRange(ByRef c As Chart, ByRef ret As Range)
  Dim r() As Range
  Dim s  As String
  Dim n  As Long
  Dim i  As Long

  n = c.SeriesCollection.Count
  ReDim r(1 To n)

  For i = 1 To n
    s = Mid$(c.SeriesCollection(i).Formula, 8)
    s = Replace(s, ",,", ",")
    s = Replace(s, "," & i & ",", ",")
    s = Replace(s, "," & i & ")", ")")
    s = "(" & Mid$(s, InStr(s, ",") + 1)
    Set r(i) = Range(s)
  Next
  Set ret = r(1)
  For i = 2 To n
    Set ret = Union(ret, r(i))
  Next
  Erase r
End Sub

あらゆるケースに対応できるわけではないですけれども。

投稿日時 - 2013-05-23 12:19:22

お礼

end-u様

二度目のご回答、感謝いたします
丁寧に記述いただきまして恐縮です
勉強してみます。

ベストアンサーとさせていただきます。

投稿日時 - 2013-05-23 13:54:14

ANo.4

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.3

>グラフの現在のデータ範囲の矩形範囲

あなたが作成しようとしているグラフは確かに矩形範囲ですが、エクセルでは飛び飛びのセル範囲からも、また系列ごとに個数が違うグラフも描けますので、「全体としての元データ範囲」を取得する方法はありません。


とりあえず簡単には
activechart.seriescollection.count

ubound(activechart.seriescollection(1).xvalues)
end sub
といったところと思います。

投稿日時 - 2013-05-23 00:31:10

お礼

早速のご回答を 
どうも 有難うございます。

やはり、結構、難解にならざるを得ないのですね・・・
私の頭で理解するのに時間がかかりそうなので
コードを勉強させていただきますね。

投稿日時 - 2013-05-23 13:51:42

ANo.2

残念ながら、
>Formulaプロパティで系列ごとに取得していく方法
です。Range型変数に代入するところはおまけです。
当方も最近、同様の事を思っておりました。もっと簡便な方法があるなら、是非知りたいです。
Sub test()
Dim mychartObj As ChartObject
Dim mySeries As Series
Dim dataRange As Range

Set mychartObj = ActiveSheet.ChartObjects(1)
For Each mySeries In mychartObj.Chart.SeriesCollection
Debug.Print Split(Split(mySeries.Formula, ",")(2), "!")(1)
Set dataRange = Worksheets(Split(Split(mySeries.Formula, ",")(2), "!")(0)).Range(Split(Split(mySeries.Formula, ",")(2), "!")(1))
Debug.Print dataRange.Parent.Name, dataRange.Address
Next mySeries
End Sub

縦横の行数の取得なら、上記コードで
Debug.Print UBound(mySeries.XValues), UBound(mySeries.Values)
でできますが、こういう事で良いのでしょうか。

投稿日時 - 2013-05-22 22:09:51

お礼

早速のご回答を 
どうも 有難うございます。

やはり、結構、難解にならざるを得ないのですね・・・
私の頭で理解するのに時間がかかりそうなので
コードを勉強させていただきますね。

投稿日時 - 2013-05-23 13:51:08

ANo.1

とりあえずActiveChartに対して処理するサンプル。
DataObjectを使う為、VBE-[ツール]-[参照設定]で
「Microsoft Forms 2.0 Object Library」にチェックする必要があります。

Sub try()
  '■参照設定:Microsoft Forms 2.0 Object Library
  Dim r As Range

  If Not ActiveChart Is Nothing Then
    SendKeys "^c{esc}"
    Application.Dialogs(xlDialogChartSourceData).Show
    On Error Resume Next
    With New DataObject
      .GetFromClipboard
      Set r = Range(.GetText)
    End With
    On Error GoTo 0
    If Not r Is Nothing Then MsgBox r.Address(external:=True)
  End If
End Sub

SendKeys使ってますから邪道で危ういし。
それに『データの選択』ダイアログに表示されない複雑なSourceDataの場合は取得できません。

素直に系列をLoopして取得したほうがスマートっぽく見えます。

投稿日時 - 2013-05-22 22:05:12

お礼

早速のご回答を 
どうも 有難うございます。

やはり、結構、難解にならざるを得ないのですね・・・
私の頭で理解するのに時間がかかりそうなので
コードを勉強させていただきますね。

投稿日時 - 2013-05-23 13:50:27

あなたにオススメの質問