![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?8acaa2e)
excel2010の
VBA利用者です。
グラフが書いてあって(種類は3D等高線グラフ)、
その元になるデータ範囲は
例えば
ActiveChart.SetSourceData Source:=Range("Sheet1!$A$1:$D$10")
のようにすれば、シート1のRange("A1:D10")の範囲が設定できます。
では、
これの 逆に
設定でなくて、取得が出来ませんでしょうか?
つまり
上記の場合でしたら、範囲"A1:D10"を取得して、変数に代入したいのです。
もし、範囲としての取得が難しいならば、最低限
グラフの現在のデータ範囲の矩形範囲の縦横の、行数、列数の
取得だけでもなんとかしたいのですが、
何か方法はないでしょうか?
縦横数百セルの大き目の範囲を相手にしたいので、
Formulaプロパティで系列ごとに取得していく方法では煩雑になるので
何とかもっと
簡便な方法が無いものかと思っております
御教授のほど、よろしくお願いいたします。
No.4ベストアンサー
- 回答日時:
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
あらゆるケースに対応できるわけではないですけれども。
end-u様
二度目のご回答、感謝いたします
丁寧に記述いただきまして恐縮です
勉強してみます。
ベストアンサーとさせていただきます。
No.3
- 回答日時:
>グラフの現在のデータ範囲の矩形範囲
あなたが作成しようとしているグラフは確かに矩形範囲ですが、エクセルでは飛び飛びのセル範囲からも、また系列ごとに個数が違うグラフも描けますので、「全体としての元データ範囲」を取得する方法はありません。
とりあえず簡単には
activechart.seriescollection.count
と
ubound(activechart.seriescollection(1).xvalues)
end sub
といったところと思います。
早速のご回答を
どうも 有難うございます。
やはり、結構、難解にならざるを得ないのですね・・・
私の頭で理解するのに時間がかかりそうなので
コードを勉強させていただきますね。
No.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)
でできますが、こういう事で良いのでしょうか。
早速のご回答を
どうも 有難うございます。
やはり、結構、難解にならざるを得ないのですね・・・
私の頭で理解するのに時間がかかりそうなので
コードを勉強させていただきますね。
No.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して取得したほうがスマートっぽく見えます。
早速のご回答を
どうも 有難うございます。
やはり、結構、難解にならざるを得ないのですね・・・
私の頭で理解するのに時間がかかりそうなので
コードを勉強させていただきますね。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) vba 等間隔の列に対しての計算 6 2022/05/17 20:15
- Excel(エクセル) Excel VBA 空白行があるセル範囲に色を付ける 3 2022/06/13 15:58
- Excel(エクセル) 単価シートから単価をエクセル関数で自動取得する方法 1 2023/07/02 22:00
- Excel(エクセル) EXCELのグラフを画像(JPG形式)で保存、通常実行がうまく行かない。ステップインはうまく行く 3 2022/08/30 12:06
- Visual Basic(VBA) Excelのマクロについて教えてください。 1 2023/03/12 12:16
- Visual Basic(VBA) 【VBA】Excelの特定範囲のセルを画像で保存したい 2 2023/01/25 13:06
- Excel(エクセル) エクセルの散布図で新たに入力した値のデータラベルが空欄になる現象 1 2022/04/26 09:31
- Excel(エクセル) エクセルの数式で教えてください。 1 2023/02/09 14:54
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
- その他(プログラミング・Web制作) pythonでクラスで複数のメソッドを利用する方法 2 2022/04/15 04:17
このQ&Aを見た人はこんなQ&Aも見ています
-
「環境が人を育てる」って本当?環境によって人格や生き方は本当に変わるのか
環境が人生に与える影響は実際どれほどのものなのか、専門家の田宮由美さんに伺った。
-
グラフの範囲指定をVBAで可変にしたい
その他(Microsoft Office)
-
[VBA]グラフの要素が参照しているセル範囲の取得
Excel(エクセル)
-
EXCEL VBA----離れたセル範囲の指定
Excel(エクセル)
-
-
4
VBAでエクセルシートを更新(リフレッシュ)する方法を教えて下さい。
Excel(エクセル)
-
5
<EXCELグラフ>データ取得範囲を最下行にしたい
Visual Basic(VBA)
-
6
エクセルのグラフのデータ系列の順序をVBAで変更する
Excel(エクセル)
-
7
EXCELでコピーしたグラフのデータ範囲変更について
Excel(エクセル)
-
8
グラフの「項目軸ラベルに使用」をVBAで
Visual Basic(VBA)
-
9
ユーザーフォームを表示中にシートの操作をさせるには
Excel(エクセル)
-
10
Excel VBAでグラフの可変データ範囲の取得方法
Visual Basic(VBA)
-
11
Excel VBAでグラフをクリックした時走るイベントありますか?
その他(プログラミング・Web制作)
-
12
エクセルのマクロでアクティブシート内の選択した複数のグラフのみ軸の目盛を変更
その他(Microsoft Office)
-
13
VBA グラフX軸の変更
その他(プログラミング・Web制作)
-
14
VBA 散布図の点の元セルを取得したい
Excel(エクセル)
-
15
エクセルVBA 配列からセルに「関数式」を一気代入したい
Visual Basic(VBA)
-
16
エクセルVBAでオートフィルター最上行を取得するには
Excel(エクセル)
-
17
cellsで特定の離れた範囲を選択する方法は?
Visual Basic(VBA)
-
18
■VBA■ SUMとAVERAGEの違い
Excel(エクセル)
-
19
マクロを実行すると画像がズレてしまいます
その他(Microsoft Office)
-
20
グラフのサイズを揃えたいのでVBAを使っていたのですが、数値軸の最大値
その他(Microsoft Office)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【スプレドシート】IMPORTRANGE...
-
エクセルやワードを無料で使え...
-
現在、PC2台でMicrosoft 365 Pe...
-
英数字のみ全角から半角に変換
-
Microsoftにofficeアプリについ...
-
大学のレポート A4で1枚レポー...
-
Office2021を別のPCにインスト...
-
エクセルでXLOOKUP関数...
-
会社のPCに入っているExcelでバ...
-
Windows 11で、IME言語バー(IM...
-
以下マクロの処理を最終行まで...
-
Microsoft Formsの「個人情報や...
-
Outlook で宛先が複数の場合の人数
-
teams設定教えて下さい。 ①ビデ...
-
Microsoft365で写真をアルバム...
-
マクロ自動コピペ 貼り付ける場...
-
VBAファイルの保存先について
-
エクセルで英文字に入れた下線...
-
複数の写真を1枚に印刷
-
Excel 日付を比較したら、同じ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【スプレドシート】IMPORTRANGE...
-
英数字のみ全角から半角に変換
-
「生産性ソフトウェア」とは何...
-
会社PCのメールが更新されない
-
【関数】○年○ヶ月と表示された...
-
WEBの記事を印刷する際にA...
-
エクセルでXLOOKUP関数...
-
Microsoft familyに追加されま...
-
会社のOutlookにてメールを予約...
-
Microsoft Formsの「個人情報や...
-
Microsoft365の一部を解約したい
-
マクロ自動コピペ 貼り付ける場...
-
Outlook で宛先が複数の場合の人数
-
outlookのメールが固まってしま...
-
【Excel VBA】PDFを作成して,...
-
大学のレポート A4で1枚レポー...
-
office365って抵抗感ないですか?
-
Microsoftにofficeアプリについ...
-
Excel テーブル内の空白行の削除
-
マイクロソフト 一時使用コード...
おすすめ情報