エクセル2003(VBA)で散布図グラフの元データの範囲を可変にしたい

質問

エクセル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

回答No.2

xls88 · ベストアンサー

＞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

お礼

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

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

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

回答No.1

xls88

≪可変データ範囲の件≫
データの最終行を取得すればよいだけではないでしょうか。

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%は解決しております。今からもう少し私自身も勉強しますが、どうかもう一声頂ければ、幸いです。
あつかましいご依頼、お許し下さい。