散布図をマクロを使って１枚のグラフに自動作成したいのですが毎回データ範囲、系列数などが変わります。

Question

前提・実現したいこと

散布図をマクロを使って１枚のグラフに自動作成したいのですが毎回データ範囲、系列数などが変わります。

ここに質問の内容を詳しく書いてください。
マクロの記録で作成して、A-1,A-2,A-3,B-1,B-2と５本のグラフを１枚のグラフに描けました。ただ毎回となるとデータ選択でデータソースの部分のマクロを修正しなくてはなりません。データ選択の部分でどのようにすれば複数データの散布図を同時に１枚のグラフ上に作成できるのでしょうか。また散布図の線の色もAで始まるもの同士同じ線の色を実現したいです。

元となるデータ
凡例となる項目　　　X軸　Y軸
A-1　　　　　　1.00　1.00
A-1　　　　　　2.00 2.00
A-2 　　　　　2.00 10.00
A-2　　　　　　3.00 20.00
A-2　　　　　　4.00 30.00
A-3 　　　　　3.00 100.00
A-3　　　　　　4.00 150.00
B-1 　　　　　1.00 1.00
B-1　　　　　　1.05 1.50
B-2 　　　　　1.00 2.00
B-2　　　　　　2.00 3.00
：
：
sub Macro1()
Range("A1:C3").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterSmooth
ActiveChart.SetSourceData Source:=Range("Sheet2!$A$1:$C$3")
ActiveWindow.SmallScroll Down:=3
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.SeriesCollection(2).Name = "=Sheet2!$A$2"
ActiveChart.SeriesCollection(2).XValues = "=Sheet2!$B$2:$B$3"
ActiveChart.SeriesCollection(2).Values = "=Sheet2!$C$2:$C$3"
ActiveChart.SeriesCollection(1).XValues = "=Sheet2!$A$4"
ActiveChart.SeriesCollection(1).Name = "=Sheet2!$A$4"
ActiveChart.SeriesCollection(1).XValues = "=Sheet2!$B$4:$B$6"
ActiveChart.SeriesCollection(1).Values = "=Sheet2!$C$4:$C$6"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Name = "=Sheet2!$A$7"
ActiveChart.SeriesCollection(3).XValues = "=Sheet2!$B$7:$B$8"
ActiveChart.SeriesCollection(3).Values = "=Sheet2!$C$7:$C$8"

（例）PHP(CakePHP)で●●なシステムを作っています。
■■な機能を実装中に以下のエラーメッセージが発生しました。

発生している問題・エラーメッセージ

エラーメッセージ

### 該当のソースコード

```ここに言語名を入力
ソースコード

試したこと

こうすれば問題なく作成されますが、次回項目数や、
ここに問題に対して試したことを記載してください。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Answer 1

とりあえずサンプルです
コメント参考にステップ実行しながら確認してみてください

Sub sample()
    Dim cht As Chart
    Dim rng As Range
    Dim rr  As Range
    Dim r   As Range
    Dim c   As Long

    With ActiveSheet
        '系列名範囲をSet
        Set rng = .Range("A2", .Range("A2").End(xlDown))
        Set cht = .Shapes.AddChart(xlXYScatterSmooth).Chart
    End With

    '系列の起点セルを覚えておきます
    Set rr = rng(1)
    '系列ごとのデータ数count用
    c = 1

    '系列名範囲をLoopします
    For Each r In rng
        If r.Value = r.Offset(1).Value Then
            '1行下の系列名が同じならCountUp
            c = c + 1
        Else
            '違ったら起点セルを基にグラフに系列追加
            Set rr = rr.Resize(c, 3)
            With cht.SeriesCollection.NewSeries
                .Name = rr(1)
                .XValues = rr.Columns(2)
                .Values = rr.Columns(3)
                '系列名1文字目でLineカラー分岐
                If Left(rr(1).Value, 1) = "A" Then
                    .Format.Line.ForeColor.RGB = vbRed
                Else
                    .Format.Line.ForeColor.RGB = vbBlue
                End If
            End With
            '起点セルとデータ数リセット
            Set rr = r.Offset(1)
            c = 1
        End If
    Next
End Sub

Comments

[koko2]

サンプルありがとうございました。試して問題なくできることを確認いたしました。細かく説明していただきとても助かります。

[koko2]

追加で教えください。線の色を変える際、系列名は実際は５,6文字くらいあります。左からの”A","B"”C"だけでなく、左から５文字、６文字をまとめて識別することはできますか？

[end-u]

左から5文字が、なら
If Left(rr(1).Value, 5) = "AAAAA" Then
左から5番目から1文字が、なら
If Mid(rr(1).Value, 5, 1) = "A" Then
左から6番目から2文字が、なら
If Mid(rr(1).Value, 6, 2) = "AA" Then

とか。
Left関数、Mid関数、…ついでにRight関数など、調べてみてください

[koko2]

回答ありがとうございました。早速やってみます。またいろいろ調べて勉強していきます。教えていただきましてありがとうございました。