ついに夏本番!さぁ、家族でキャンプに行くぞ! >>

エクセル2003の散布図グラフで複数の系列を表示しています。ところが
データの量(行数)がすぐに変わりますので元データの範囲を可変したいのですが
うまくいきません。
また、グラフ作成後、下記コードにてラベルの一括貼付けをしております。
下記に具体的なデータを記載しますので、どうかお知恵をお貸し下さい。
よろしくお願い致します。

■現在
元データのプロパティ より
Xの値:=Sheet1!$E$3:$E$324
Yの値:=Sheet1!$F$3:$F$324
 ※本当はここで"Sheet1!$E$3:$E$65536"とSheet1!$F$3:$F$65536にすれば
   データは取得できますが、下記マクロを実行すると当然オーバーフローします
   要はここで存在するデータ範囲に都度変わっていくような事ができれば
   それでも解決するかも?

□使用しているマクロ
Sub 全系列の一括ラベル表示()
Dim Counter As Integer, ChartName As String, xVals As String
Application.ScreenUpdating = False
For i = 1 To ActiveChart.SeriesCollection.Count
'Store the formula for the first series in "xVals".
xVals = ActiveChart.SeriesCollection(i).Formula

'''''' 'ここでxvalsにデータ元が入ったままなのでそれを存在するデータ範囲に変わるようにしたいーーーー

xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop
For Counter = 1 To Range(xVals).Cells.Count
If Range(xVals).Cells(Counter, 1).Offset(0, -1).Value = "" Then
With ActiveChart.SeriesCollection(i).Points(Counter)
.HasDataLabel = True
.DataLabel.Text = ""
End With
Else
With ActiveChart.SeriesCollection(i).Points(Counter)
.HasDataLabel = True
.DataLabel.Text = Range(xVals).Cells(Counter, 1).Offset(0, -1).Value
End With
End If
Next Counter
Next i
End Sub

このQ&Aに関連する最新のQ&A

A 回答 (2件)

>Set grng = Range("E3", Cells(Rows.Count, "F").End(xlUp)) '当然Rangeが取得できない?


シート名が省略されていますからActivesheetが操作対象になります。
シート名で修飾しなければなりません。

各SeriesCollectionのFormulaからシート名を抜き取ります。
Xの値の開始セルは$E$3
Yの値の開始セルは$F$3
で共通ということでよかったですか。

Sub test1()
  Dim ws As String
  Dim r As Long
  Dim i As Long
  With ActiveSheet.ChartObjects(1).Chart
    For i = 1 To .SeriesCollection.Count
      With .SeriesCollection(i)
        ws = Split(Split(.Formula, ",")(1), "!")(0)
        r = Worksheets(ws).Cells(Rows.Count, "F").End(xlUp).Row
        .XValues = Worksheets(ws).Range("E3", "E" & r)
        .Values = Worksheets(ws).Range("F3", "F" & r)
      End With
    Next i
  End With
End Sub
    • good
    • 1
この回答へのお礼

解決!!!
上記のマクロを使わせて頂き無事、解決に至りました^^
丁寧な迅速なご対応、感謝します!ありがとうございましたm _ _ m

>Xの値の開始セルは$E$3
>Yの値の開始セルは$F$3
>で共通ということでよかったですか。
はい、その通りでした後手に回った設定、お許し下さい。

後記
なぜかステップではうまくいきますが普通に走らせると、10回に一回ぐらいは最終行取得の所で止まってしまいます。うーーんメモリ?の問題なのかなぁ

お礼日時:2009/05/27 08:34

≪可変データ範囲の件≫


データの最終行を取得すればよいだけではないでしょうか。

Dim grng As Range
Set grng = Range("E3", Cells(Rows.Count, "F").End(xlUp))
ActiveSheet.ChartObjects(1).Chart.SetSourceData Source:=grng

あるいは

Dim r As Long
r = Cells(Rows.Count, "F").End(xlUp).Row
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
  .XValues = Range("E3", "E" & r)
  .Values = Range("F3", "F" & r)
End With

一般機能でも可能です。
Excel で定義名を使用してグラフ範囲を自動的に更新する方法
http://support.microsoft.com/kb/183446/ja

この回答への補足

素早いご対応、ありがとうございました。
非常に有益な情報で、心から感謝しております。
さて、本題ですが、ご回答頂いたマクロを私のマクロに組み込んだのですが、エラーが出てしまいました。
理由ははっきりしており私の前提条件の提示がしっかりとされていなかったからです。本当にもうしわけございません。
下記に再度、詳細な条件を記載させて頂きます。

■現在
元データのプロパティ より
○シート1(系列1)
Xの値:=Sheet1!$E$3:$E$324
Yの値:=Sheet1!$F$3:$F$324
○シート2(系列2)
Xの値:=Sheet2!$E$3:$E$654
Yの値:=Sheet2!$F$3:$F$654
・・・・
 ※以下このように系列ごとにシートを分けており、合計5シートの元データがあります。
 ※また全ての行の途中に空白はありません。

■マクロ
Sub 全系列のラベル表示() '全系列のラベル表示

Dim Counter As Integer, ChartName As String, xVals As String

Application.ScreenUpdating = False

For i = 1 To ActiveChart.SeriesCollection.Count '系列の数だけループさせる

xVals = ActiveChart.SeriesCollection(i).Formula

' 頂いたコードをそのまま貼り付けてみました。
' Dim grng As Range
' Set grng = Range("E3", Cells(Rows.Count, "F").End(xlUp)) '当然Rangeが取得できない?
' ActiveSheet.ChartObjects(1).Chart.SetSourceData Source:=grng

xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop

For Counter = 1 To Range(xVals).Cells.Count
If Range(xVals).Cells(Counter, 1).Offset(0, -1).Value = "" Then
With ActiveChart.SeriesCollection(i).Points(Counter)
.HasDataLabel = True
.DataLabel.Text = ""
End With
Else
With ActiveChart.SeriesCollection(i).Points(Counter)
.HasDataLabel = True
.DataLabel.Text = Range(xVals).Cells(Counter, 1).Offset(0, -4).Value
End With
End If
Next Counter
Next i
MsgBox "完了"
End Sub

■後記
エラーの理由はおそらくRangeのシートを参照できなかっただけだと思うのですが、既に90%は解決しております。今からもう少し私自身も勉強しますが、どうかもう一声頂ければ、幸いです。
あつかましいご依頼、お許し下さい。

補足日時:2009/05/26 09:12
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QVBAで散布図(グラフ)の作成

VBAでセルの値を読み込み散布図である折れ線グラフを作成しました。しかし、x軸に指定したい列も折れ線(xlScatterLines)で表示されてしまい思い通りになりません。どのようなキーワードでx軸を指定できるのでしょうか?ちなみに、そのグラフの[元のデータ]を参照するとやはりx軸の項目が空欄になっています。

Aベストアンサー

私なりにまとめてみました。参考になりますでしょうか。
反例などありましたら、指摘してください。
ここでは項目データが、列ごとに記録されているシートを考えます。
A列に体重、B列に身長、C列に年令などの例です。
(1)エクセルの散布図は2次元の図です。縦横の座標データが必要です。
また3つ以上あっても、2次元散布図では書けません。
シートに沢山(3列以上)の系列がある場合は、3系列以上指定するまたは指定しないと、それぞれが折れ線グラフで線なしの点グラフになってしまいます。
(2)2列の同行データでy軸、x軸で測って、交差する位置に点が描かれます。
(3)文字列の列があっても、2列しか数値データがない場合は、最初に出てくる数値列と次に出てくる数値列の2つが取り上げられます。
指定しないと、上例では体重と身長の散布図となります。
A列に近いほうから、最初にあるデータ列がX軸になり、次にあるデータ列がY軸になります。グラフウイザードの2/4でデータ範囲を、逆転させて
指定しても、逆になりません。列を入れかえるより他ないようです。
しかし隣り合わない、2つの列を指定したい(例えば体重と年令)場合は、体重列と年令列を(CTRLキーを押して)範囲指定して、グラフを描かせれば良い。
(4)そのほかに、Y軸の目盛の範囲を決めたいときは、一旦グラフを作成しY軸をクリックして、右クリックして、「軸の書式設定」を選び、「目盛」タブを選び、Y/数値軸目盛の最小値・最大値を指定します。身長であれば最小140、最大190とか指定します。X軸との交差点も指定します。
(5)あとX軸の目盛の範囲を決めたいときは、一旦グラフを作成しX軸をクリックして、右クリックして、「軸の書式設定」を選び、「目盛」タブを
選び、X/数値軸目盛の最小値・最大値を指定します。体重であれば最小50、最大90とか指定します。
(6)以上で目盛り線、凡例、タイトル、マーカー、データラベルなどを除いた、数値的な仕様が決まります。
--------
さて本題の、VBAでは
(A)散布図は
Charts.Add
ActiveChart.ChartType = xlXYScatter
(B)系列はActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("A1:D7"), PlotBy:= _
xlColumns
この例ではA、C列は文字列の例でした。
列方向にデータ系列を考えるときはPlotBy:=xlColumnsです。
(C)グラフにするデータの列(と範囲)の指定は
C,D列に数値データがあるときの例では
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("C1:D7")
離れた範囲の場合は
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("C1:C7,E1:E7"),
(D)X軸の最高値と最低値、Y軸の最高値と最低値、交差する点を
定義するのは下記で行う。
ActiveChart.Axes(xlCategory).Select
With ActiveChart.Axes(xlCategory)
.MinimumScale = 50
.MaximumScale = 100
.CrossesAt = 50
End With
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = 20
.MaximumScale = 100
.CrossesAt = 20
End With

私なりにまとめてみました。参考になりますでしょうか。
反例などありましたら、指摘してください。
ここでは項目データが、列ごとに記録されているシートを考えます。
A列に体重、B列に身長、C列に年令などの例です。
(1)エクセルの散布図は2次元の図です。縦横の座標データが必要です。
また3つ以上あっても、2次元散布図では書けません。
シートに沢山(3列以上)の系列がある場合は、3系列以上指定するまたは指定しないと、それぞれが折れ線グラフで線なしの点グラフになってしまいます。
...続きを読む

QExcel VBAで、散布図のデータ範囲が正しく指定されない

VBA初心者です。
アクティブシート上に、散布図を作成したいのですが・・・

Dim mySheet, mySheetName
Set mySheet = ActiveSheet
mySheetName = ActiveSheet.Name
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=mySheet.Range("A1:C10")
ActiveChart.Location Where:=xlLocationAsObject, Name:=mySheetName

これを実行させた時アクティブなセルに数字が存在すると、データ範囲が「A1:C10」ではなく、アクティブなセルになってしまいます。
原因を教えていただけないでしょうか。よろしくお願いします。

Aベストアンサー

こんにちは。

Charts.Addでグラフが出来ますが、その時点でのデータ範囲は現在選択されてる範囲になり、
次に、SetSourceData Sourceで範囲が変更さますので、Charts.Addの前に範囲選択をして下さい。

 Range("A1:C10").Select
 Charts.add

以上です。
 

QEXCEL2007

EXCEL2007 <VBAで散布図の系列の追加>


標記の通り、VBAで散布図に新たに系列を追加したいのです。
たとえば現在、系列1があるとします。
そこで、横軸がA1:A10、縦軸がB1:B10のデータを追加するとします。

    ActiveChart.SeriesCollection.Add Range("A1:B10")

しかし、このマクロだと縦軸がA1:A10の系列2と縦軸がB1:B10の系列3ができてしまします。

そこで、ためしに

    ActiveChart.SeriesCollection.Add Range("A1")   '仮に作る

    With ActiveChart.SeriesCollection(2)
      .XValues = Range("A1:A10")
      .Values = Range("B1:B10")
    End With

とすると、「実行時エラー'1004'; アプリケーション定義またはオブジェクト定義のエラーです。」となります。


いろいろ検索したのですが、これと言ったのがみつかりません。
意図するマクロはどのようなものになるのでしょうか。
ご教示お願いします。

EXCEL2007 <VBAで散布図の系列の追加>


標記の通り、VBAで散布図に新たに系列を追加したいのです。
たとえば現在、系列1があるとします。
そこで、横軸がA1:A10、縦軸がB1:B10のデータを追加するとします。

    ActiveChart.SeriesCollection.Add Range("A1:B10")

しかし、このマクロだと縦軸がA1:A10の系列2と縦軸がB1:B10の系列3ができてしまします。

そこで、ためしに

    ActiveChart.SeriesCollection.Add Range("A1")   '仮に作る

    With ActiveChart.SeriesCollection(2)
    ...続きを読む

Aベストアンサー

NewSeriesメソッドで系列が追加出来ます。

ActiveChartがグラフシートならセルは持っていません。
よって
.XValues = Range("A1:A10")
は成立しません。
元データがあるシート名を明記してください。

≪例1≫
With ActiveChart.SeriesCollection.NewSeries
  .XValues = Sheets("Sheet1").Range("A1:A10")
  .Values = Sheets("Sheet1").Range("B1:B10")
End With

≪例2≫
With Charts("Graph1").SeriesCollection.NewSeries
  .XValues = Sheets("Sheet1").Range("A1:A10")
  .Values = Sheets("Sheet1").Range("B1:B10")
End With

≪例3≫
With Charts(1).SeriesCollection.NewSeries
  .XValues = Sheets("Sheet1").Range("A1:A10")
  .Values = Sheets("Sheet1").Range("B1:B10")
End With

NewSeriesメソッドで系列が追加出来ます。

ActiveChartがグラフシートならセルは持っていません。
よって
.XValues = Range("A1:A10")
は成立しません。
元データがあるシート名を明記してください。

≪例1≫
With ActiveChart.SeriesCollection.NewSeries
  .XValues = Sheets("Sheet1").Range("A1:A10")
  .Values = Sheets("Sheet1").Range("B1:B10")
End With

≪例2≫
With Charts("Graph1").SeriesCollection.NewSeries
  .XValues = Sheets("Sheet1").Range("A1:A10")
  .Values = Sheets("Sheet1")....続きを読む

QエクセルVBAでグラフの線とマーカを設定したい

エクセルVBAでグラフの線とマーカを設定したいです。
グラフの線は無しでマーカの線が有りにしたいのですが、
マクロで記録したコードを見ると
グラフの線、マーカの線ともにFormat.Line.Visibleで指定しています。
実際にコードを記述しても、以下の様になり、グラフの線が表示されてしまいます。
ChartObjects("1").Chart.SeriesCollection(10).Format.Line.Visible = msoFalse

With ChartObjects("1").Chart.SeriesCollection(10).Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 102, 0)
.Transparency = 0
End With
グラフの線は無しでマーカの線が有りに設定は出来ないのでしょうか?

Aベストアンサー

With ChartObjects("1").Chart.SeriesCollection(10)
.Format.Line.Visible = msoFalse
.MarkerForegroundColor = RGB(255, 102, 0)
End With

あるいは下記で折れ線のみ塗りつぶしなしになります。
Border.ColorIndex = xlNone

Qグラフの範囲指定をVBAで可変にしたい

1シートに複数のグラフがあり、値を入れて完成させているファイルがあります。
データ範囲が毎回違うため、いちいちグラフを選択し、範囲を変更しています。

系列:行
データ範囲:A列から~H列までだったり、A列からJ列までだったりします

データがH列までの場合はI列は値が入っていませんが、L列からまた他のグラフのデータ範囲になっているという形です。

データが始まる位置はすべて固定です。

シートにある複数のグラフを一度に変更したいのですが、どのようにしたら良いのでしょうか?
(選択しているグラフのグラフ変更ではなく、選択していないものも変更したい)
以下のようなマクロを仮で組んでみたのですが、うまく動きません。

よろしくお願いします。


Sub グラフ範囲変更()
Dim lastcolumn As Integer
lastcolumn = Range("A2").End(xlToRight).Column
ActiveChart.SetSourceData Source:=Range(Cells(1, 1), Cells(1, lastcolumn))
End Sub

1シートに複数のグラフがあり、値を入れて完成させているファイルがあります。
データ範囲が毎回違うため、いちいちグラフを選択し、範囲を変更しています。

系列:行
データ範囲:A列から~H列までだったり、A列からJ列までだったりします

データがH列までの場合はI列は値が入っていませんが、L列からまた他のグラフのデータ範囲になっているという形です。

データが始まる位置はすべて固定です。

シートにある複数のグラフを一度に変更したいのですが、どのようにしたら良いのでしょうか?
(選択している...続きを読む

Aベストアンサー

>No.4 この回答への補足
>=SERIES(グラフ!$B$45,グラフ!$C$26:$J$26,グラフ!$C$45:$J$45,8)
SERIES式をみると
Xのセル範囲とYのセル範囲の行数が系列NO以上に離れています。
各系列のYのセル範囲もそれぞれ離れているのですか?
それとも隣り合っていますか?

各系列のYのセル範囲は隣接しているが、Xのセル範囲とは数行離れているようです。
違いますか?
No.4までの回答は
各系列名セル範囲、Xのセル範囲、各系列のYのセル範囲は隣接して
矩形セル範囲内にあるとして考えています。
従って、思ったような結果は得られていないと思います。

>B45   他のセルからの転記
手打ち入力ですか?それとも数式で参照表示ですか?
手打ち入力という事ですね?

>C26:J26 1~8までの単純な数値
手打ち入力という事ですね?

>C45:J45 数式。C35は=IF(C35="","",C$27-C35)
C35はC45の間違いでは?
C45は=IF(C35="","",C$27-C35)

>おそらく見えていないグラフがインデックス番号1になっており、REFになったようです。
インデックス番号の所為ではないと思います。
「見えていないグラフ」とは???です。


新たに提示して頂けた情報から判断して
系列ごとにデータ範囲を設定した方が確実かも知れません。
戻り値が数値のセルは連続している事として
SpecialCellsプロパティで、戻り値が数値になっているセル範囲を特定します。
グラフ指定でChartObjects(1)のインデックスは適宜書き換えてください。
ChartObjects("グラフ 1")というように名前にした方が特定し易いかも知れません。
まだまだ検討の余地はありますが取りあえずサンプルコードを提示してみます。

Dim ser As Series
Dim fmla As String
Dim xrng As Range
Dim yrng As Range
Dim plt As Long

With ActiveSheet.ChartObjects(1)
plt = cht.Chart.PlotBy
If plt <> 0 Then
For Each ser In cht.Chart.SeriesCollection
fmla = ser.Formula
Set xrng = Range(Split(fmla, ",")(1))
Set yrng = Range(Split(fmla, ",")(2))
Select Case plt
Case 1 'xlRows(データ系列は列)
Set yrng = Range(yrng, yrng.End(xlToRight))
Set yrng = yrng.SpecialCells(xlCellTypeFormulas, 1)
Case 2 'xlColumns(データ系列は行)
Set yrng = Range(yrng, yrng.End(xlDown))
Set yrng = yrng.SpecialCells(xlCellTypeFormulas, 1)
End Select
With ser
.XValues = xrng.Resize(yrng.Rows.Count, yrng.Columns.Count)
.Values = yrng
End With
Next ser
End If
End With

>No.4 この回答への補足
>=SERIES(グラフ!$B$45,グラフ!$C$26:$J$26,グラフ!$C$45:$J$45,8)
SERIES式をみると
Xのセル範囲とYのセル範囲の行数が系列NO以上に離れています。
各系列のYのセル範囲もそれぞれ離れているのですか?
それとも隣り合っていますか?

各系列のYのセル範囲は隣接しているが、Xのセル範囲とは数行離れているようです。
違いますか?
No.4までの回答は
各系列名セル範囲、Xのセル範囲、各系列のYのセル範囲は隣接して
矩形セル範囲内にあるとして考えています。
従って、思ったような結果...続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QエクセルVBAでグラフの範囲を設定する方法

お世話になっています。

グラフ自体は、作成済みのものを使用して、データの範囲だけを
変更させる方法を考えています。

A列に、データが入っている範囲を選択して、選択したセル範囲を
グラフのデータ範囲としたいと思います。

現在、作成したプログラムは以下のものです。
当たり前なんでしょうが、以下のものではエラーになります。
Loopコマンドで、アクティブになったセルをグラフのデータ範囲に
設定する方法を教えてください。

よろしくお願いします。


Sub グラフ作成()
'
Dim 範囲 As String

Range("A1").Select
Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Offset(-1, 0).Activate
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlUp)).Select
  範囲 = ActiveCell

ActiveSheet.ChartObjects("グラフ 1").Activate
ActiveChart.SetSourceData Source:=Range(範囲)

End Sub

お世話になっています。

グラフ自体は、作成済みのものを使用して、データの範囲だけを
変更させる方法を考えています。

A列に、データが入っている範囲を選択して、選択したセル範囲を
グラフのデータ範囲としたいと思います。

現在、作成したプログラムは以下のものです。
当たり前なんでしょうが、以下のものではエラーになります。
Loopコマンドで、アクティブになったセルをグラフのデータ範囲に
設定する方法を教えてください。

よろしくお願いします。


Sub グラフ作成()
'
Dim 範囲 As String

Range...続きを読む

Aベストアンサー

Sub グラフ作成()
'
Dim 範囲 As Range

Range("A1").Select
Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Offset(-1, 0).Activate
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlUp)).Select
Set 範囲 = Selection

ActiveSheet.ChartObjects("グラフ 1").Activate
ActiveChart.SetSourceData Source:=範囲

End Sub

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

excel2010の
VBA利用者です。

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

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

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

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

Aベストアンサー

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

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

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")...続きを読む

QVBA グラフを複数作成する場合

マクロにてグラフを複数作成しようと考えています

しかし、ループを使用してグラフを作成すると
1つ以上の場合エラーになってしまい作成できません

どのように作成したらよいのでしょうか?
2つ目以降のグラフObjectの名前が重なるからエラーになるとか、そういう部分での問題でしょうか?

-------------------------------------

Sub Graph
  For i = 1 To 2 'source_cnt
  Call Make_Graph(引数)
  Next
End Sub

-------------------------------------

Sub Make_Graph(引数)

With ActiveSheet.ChartObjects.Add( _
Left:=Range(***).Left, _
Top:=Range(***).Top, _
Width:=Range(***).Width, _
Height:=Range(***).Height)
.Chart.ChartType = xlRadar
.Chart.SetSourceData Source:= Range(***), PlotBy:=xlColumns
.Chart.Location Where:=xlLocationAsObject, Name:=WorkSheet.Name
.Chart.HasLegend = False
End With

-------------------------------------

マクロにてグラフを複数作成しようと考えています

しかし、ループを使用してグラフを作成すると
1つ以上の場合エラーになってしまい作成できません

どのように作成したらよいのでしょうか?
2つ目以降のグラフObjectの名前が重なるからエラーになるとか、そういう部分での問題でしょうか?

-------------------------------------

Sub Graph
  For i = 1 To 2 'source_cnt
  Call Make_Graph(引数)
  Next
End Sub

-------------------------------------

Sub Make_...続きを読む

Aベストアンサー

標準モジュールに、質問のコードを一部手直しして、下記にして貼り付け実行しました。2つレーダーチャートを描きましたが。
後はご自分で改良してください。
Dim i
Sub Graph()
For i = 1 To 2 'source_cnt
Call Make_Graph
Next
End Sub
Sub Make_Graph()

With ActiveSheet.ChartObjects.Add( _
Left:=Cells(2, i * 5).Left, _
Top:=Cells(2, i * 5).Top, _
Width:=200, _
Height:=300)
.Chart.ChartType = xlRadar
.Chart.SetSourceData Source:=Range(Cells(1, 1), Cells(10, i)), PlotBy:=xlColumns
'.Chart.Location Where:=xlLocationAsObject, Name:=Worksheet.Name
.Chart.HasLegend = False
End With
End Sub

標準モジュールに、質問のコードを一部手直しして、下記にして貼り付け実行しました。2つレーダーチャートを描きましたが。
後はご自分で改良してください。
Dim i
Sub Graph()
For i = 1 To 2 'source_cnt
Call Make_Graph
Next
End Sub
Sub Make_Graph()

With ActiveSheet.ChartObjects.Add( _
Left:=Cells(2, i * 5).Left, _
Top:=Cells(2, i * 5).Top, _
Width:=200, _
Height:=300)
.Chart.ChartType = xlRadar
.Chart.SetSourceData Source:=Range(Cells(1, 1), Cells(10, i)...続きを読む

QExcel VBAでグラフ作成。A,C列をx値, B,D列をy値にした複数プロット

ExcelのVBAでグラフをChartType = xlXYScatterLinesでグラフを作っています。仮に各列10行でAからF列までデータがあるとします。
Set chartObj = ActiveSheet.ChartObjects.Add(170, 170, 280, 170)
With chartObj.Chart
.ChartType = xlXYScatterLines
.SetSourceData Worksheets(1).Range("A1:F10"), _
PlotBy:=xlColumns
.HasLegend = False
End With

上記のようにしてしまうと、x値がA1:A10で、y値がB1:B10,C1:C10・・・・のプロットが5本作成されてしまいます。

以下のようにするにはどうすればよろしいでしょうか。
第一のプロットはx値をA1:A10, y値をB1:B10としてグラフを作成します。次にこのグラフにx値をC1:C10, y値をD1:D10とした第二のプロットを追加、同様に第三はx値をE1:E10, y値をF1:F10としてプロットを追加したグラフを作成したいのですが、このようなグラフはVBAで作成可能でしょうか。

本番のグラフは行数と列数はいろいろな場合があるので、行数と列数のパラメータに任意の値を代入し、Forループで様々な形態に対応できるものを作りたいと考えています。

ExcelのVBAでグラフをChartType = xlXYScatterLinesでグラフを作っています。仮に各列10行でAからF列までデータがあるとします。
Set chartObj = ActiveSheet.ChartObjects.Add(170, 170, 280, 170)
With chartObj.Chart
.ChartType = xlXYScatterLines
.SetSourceData Worksheets(1).Range("A1:F10"), _
PlotBy:=xlColumns
.HasLegend = False
End With

上記のようにしてしまうと、x値がA1:A10で、y値がB1:B10,C1:C10・・・・のプロットが5本作成されてしまいます。

以下のようにするにはどうすれ...続きを読む

Aベストアンサー

Dim chartObj As ChartObject
Dim r As Range
Dim i As Long

Set chartObj = ActiveSheet.ChartObjects.Add(170, 170, 280, 170)
Set r = Worksheets(1).Range("A1:F10")
With chartObj.Chart
  .ChartType = xlXYScatterLines
  .HasLegend = False
  For i = 1 To 5 Step 2
    With .SeriesCollection.NewSeries
      .XValues = r.Columns(i)
      .Values = r.Columns(i + 1)
    End With
  Next
End With

Set r = Nothing
Set chartObj = Nothing

...こんな感じ。
普通に手作業で作成するものをマクロ記録すればヒントになるでしょう。
後から系列を追加すればいいわけです。

>本番のグラフは行数と列数はいろいろな場合があるので...
...に対応させる一例としては以下。

Const MN = 1 'データ開始行
Const MX = 10 'データ個数
Dim chartObj As ChartObject
Dim x, y
Dim z As Long
Dim i As Long

x = VBA.Array(1, 3, 5) 'x値の列
y = VBA.Array(2, 4, 6) 'y値の列
Set chartObj = ActiveSheet.ChartObjects.Add(170, 170, 280, 170)
With chartObj.Chart
  .ChartType = xlXYScatterLines
  .HasLegend = False
  For i = 0 To UBound(x)
    With .SeriesCollection.NewSeries
      .XValues = Cells(MN, x(i)).Resize(MX)
      .Values = Cells(MN, y(i)).Resize(MX)
    End With
  Next
End With

Set chartObj = Nothing

Dim chartObj As ChartObject
Dim r As Range
Dim i As Long

Set chartObj = ActiveSheet.ChartObjects.Add(170, 170, 280, 170)
Set r = Worksheets(1).Range("A1:F10")
With chartObj.Chart
  .ChartType = xlXYScatterLines
  .HasLegend = False
  For i = 1 To 5 Step 2
    With .SeriesCollection.NewSeries
      .XValues = r.Columns(i)
      .Values = r.Columns(i + 1)
    End With
  Next
End With

Set r = Nothing
Set chartObj = Nothing

.....続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング