[[20210715095352]]　『VBAでグラフの範囲を変更しながら、連続作成』（タム）　ページの最後に飛ぶ

『VBAでグラフの範囲を変更しながら、連続作成』（タム）

VBAでグラフの範囲を変更しながら、連続で作成したいです。
以下のコードを記載しましたが、範囲をうまく変更できず困っております。
申し訳ございませんが、どなたかご教示お願いします。

※やりたいこと
B列のIDが同じ値（ID61）の範囲でグラフをNO1から一列づつ作成し、最後のNO７（列は可変で増えたり、減ったりします）まで作成完了したら、下のID（ID62）の範囲でグラフをNO1から一列づつ作成し、最後のNO７作成といったぐらいにB列（ID）の最終行まで読み込む

'グラフ作成に必要な最終列を取得
EndCol = sh.Cells(2, Columns.Count).End(xlToLeft).Column
'First_Row, x)), sh.Cells(Lost_Row

'外ループグラフを一項目づつ作成するためのループ
'初期値セル[F1]の No1)から開始するため
x = 6
'グラフ加工用処理
d = " "

For i = 2 To EndCol

'グラフタイトル加工用処理
strCell = sh.Cells(2, 2).Text
strTitle = sh.Cells(1, x).Text
strJoin = str + strCell + d + strTitle

With ActiveSheet.Shapes.AddChart.Chart
'グラフ種類設定
.ChartType = xlLine
'グラフ範囲指定
.SetSourceData Source:=Union(sh.Range(sh.Cells(First_Row, 4), sh.Cells(Lost_Row, 4)), _
sh.Range((sh.Cells(First_Row, x)), sh.Cells(Lost_Row, x)))
'グラフタイトル表示
.HasTitle = True

'タイトル文字列設定
.ChartTitle.Text = strJoin
'グラフ位置の設定
.Parent.Top = Range("B" & ((i - 2) * 28 + 2)).Top
.Parent.Left = Range("B" & ((i - 2) * 15 + 2)).Left
End With

'グラフ項目移動用カウンター
x = x + 1
'ループ終了
Next i

＜使用 Excel：Office365、使用 OS：Windows10 ＞

サンプルデータを提示してください

（マナ） 2021/07/15(木) 16:54

サンプルデータを提示してください
　↑

すみません。
どのように掲示すればよろしいでしょうか？
（タム） 2021/07/15(木) 16:59

１）D列を選んで、空白列挿入
２）D1;J30の範囲をコピー（挿入した空白列も含めること）
３）ここに貼り付け

とりあえず、これでお願いします。

（マナ） 2021/07/15(木) 17:13

	TIME	Name	No1	No2	No3	No4
	0:00:00	Server1	99.966	370	370	99.625
	1:00:00	Server1	99.964	66	66	100
	2:00:00	Server1	99.981	870	870	99.776
	3:00:00	Server1	100	418	418	99.759
	4:00:00	Server1	99.981	358	358	100
	5:00:00	Server1	99.927	1032	1032	99.819
	6:00:00	Server1	99.982	2391	2391	99.512
	7:00:00	Server1	99.911	1952	1952	99.814
	8:00:00	Server1	99.978	1964	1964	99.848
	9:00:00	Server1	99.972	2620	2620	99.858
	10:00:00	Server1	99.972	1388	1388	99.756
	11:00:00	Server1	99.913	2441	2441	99.924
	12:00:00	Server1	99.942	2728	2728	99.914
	13:00:00	Server1	100	962	962	99.686
	14:00:00	Server1	100	580	580	99.837
	15:00:00	Server1	100	2429	2429	99.841
	16:00:00	Server1	99.947	1287	1287	99.691
	17:00:00	Server1	100	1940	1940	99.944
	18:00:00	Server1	99.762	2575	2575	99.888
	19:00:00	Server1	99.906	2736	2736	99.877
	20:00:00	Server1	99.983	2702	2702	99.747
	21:00:00	Server1	99.967	2125	2125	99.674
	22:00:00	Server1	99.968	59	59	100.13
	23:00:00	Server1	99.967	2793	2793	99.598

（タム） 2021/07/15(木) 17:40

間違えました。D列でなくB列でした。

１）B列を選んで、空白列挿入
２）B[1;J30の範囲をコピー（挿入した空白列も含めること）
３）ここに貼り付け

（マナ） 2021/07/15(木) 18:11

	ID	DAY	TIME	Name	No1	No2	No3	No4
	61	2021/6/24	0:00:00	Server1	99.966	370	370	99.625
	61	2021/6/24	1:00:00	Server1	99.964	66	66	100
	61	2021/6/24	2:00:00	Server1	99.981	870	870	99.776
	61	2021/6/24	3:00:00	Server1	100	418	418	99.759
	61	2021/6/24	4:00:00	Server1	99.981	358	358	100
	61	2021/6/24	5:00:00	Server1	99.927	1032	1032	99.819
	61	2021/6/24	6:00:00	Server1	99.982	2391	2391	99.512
	61	2021/6/24	7:00:00	Server1	99.911	1952	1952	99.814
	61	2021/6/24	8:00:00	Server1	99.978	1964	1964	99.848
	61	2021/6/24	9:00:00	Server1	99.972	2620	2620	99.858
	61	2021/6/24	10:00:00	Server1	99.972	1388	1388	99.756
	61	2021/6/24	11:00:00	Server1	99.913	2441	2441	99.924
	61	2021/6/24	12:00:00	Server1	99.942	2728	2728	99.914
	61	2021/6/24	13:00:00	Server1	100	962	962	99.686
	61	2021/6/24	14:00:00	Server1	100	580	580	99.837
	61	2021/6/24	15:00:00	Server1	100	2429	2429	99.841
	61	2021/6/24	16:00:00	Server1	99.947	1287	1287	99.691
	61	2021/6/24	17:00:00	Server1	100	1940	1940	99.944
	61	2021/6/24	18:00:00	Server1	99.762	2575	2575	99.888
	61	2021/6/24	19:00:00	Server1	99.906	2736	2736	99.877
	61	2021/6/24	20:00:00	Server1	99.983	2702	2702	99.747
	61	2021/6/24	21:00:00	Server1	99.967	2125	2125	99.674
	61	2021/6/24	22:00:00	Server1	99.968	59	59	100.13
	61	2021/6/24	23:00:00	Server1	99.967	2793	2793	99.598

（タム） 2021/07/15(木) 18:13

26行目以降は、空白ということでしょうか？

（マナ） 2021/07/15(木) 19:28

失礼しました

26行目以降です

401040 62 2021/6/24 0:00:00 Server1 100 66 66 100 100 100 0
401040 62 2021/6/24 1:00:00 Server1 99.858 160 160 100 100 100 0
401040 62 2021/6/24 2:00:00 Server1 100 44 44 100 100 100 2
401040 62 2021/6/24 3:00:00 Server1 99.933 51 51 100 100 100 0
401040 62 2021/6/24 4:00:00 Server1 100 76 76 100 100 100 0
401040 62 2021/6/24 5:00:00 Server1 100 99 99 97.727 100 100 1
401040 62 2021/6/24 6:00:00 Server1 100 1344 1344 100 100 100 6
401040 62 2021/6/24 7:00:00 Server1 99.943 1311 1311 100 99.315 99.779 3
401040 62 2021/6/24 8:00:00 Server1 100 58 58 100 100 99.744 2
401040 62 2021/6/24 9:00:00 Server1 99.919 228 228 99.805 98.63 100 1
401040 62 2021/6/24 10:00:00 Server1 99.957 2562 2562 100 100 99.383 2
401040 62 2021/6/24 11:00:00 Server1 100 2199 2199 99.824 100 99.708 1
401040 62 2021/6/24 12:00:00 Server1 99.96 1993 1993 99.794 100 99.702 8
401040 62 2021/6/24 13:00:00 Server1 100 1347 1347 100 98.726 100 1
401040 62 2021/6/24 14:00:00 Server1 100 337 337 99.787 99.425 99.66 0
401040 62 2021/6/24 15:00:00 Server1 99.725 2765 2765 99.835 98.76 99.171 5
401040 62 2021/6/24 16:00:00 Server1 99.919 1911 1911 99.839 98.261 100 6
401040 62 2021/6/24 17:00:00 Server1 100 2303 2303 99.686 99.074 99.282 8
401040 62 2021/6/24 18:00:00 Server1 100 481 481 99.825 100 100 1
401040 62 2021/6/24 19:00:00 Server1 100 2894 2894 99.592 100 100 1
401040 62 2021/6/24 20:00:00 Server1 99.891 561 561 100 100 99.556 0
401040 62 2021/6/24 21:00:00 Server1 100 954 954 99.561 100 100 0
401040 62 2021/6/24 22:00:00 Server1 100 67 67 99.359 100 98.947 1
401040 62 2021/6/24 23:00:00 Server1 99.931 53 53 100 100 100 0

（タム） 2021/07/15(木) 20:25

では、データは24行毎に、B列のIDが変わるということですか

（マナ） 2021/07/15(木) 20:34

はい、そのご認識で間違いありません。
（タム） 2021/07/15(木) 20:36

作成するグラフは、IDが10種あれば、10×7＝70個ですか
それとも、ID毎に１つのグラフとし、各グラフの系列が7個ですか

（マナ） 2021/07/15(木) 20:48

作成するグラフは、IDが10種あれば、10×7＝70個ですか
　↑
上記になります。
IDが増えれば増えただけグラフも増えます。

ID＿61のグラフ10個
ID＿62のグラフ10個
ID＿63のグラフ10個
　・
　・
　・
（タム） 2021/07/15(木) 20:54

グラフの雛形を用意しておいて、

１）グラフ複製
２）データの入れ替え
３）グラフ位置調整
４）繰り返し

では、だめでしょうか。

（マナ） 2021/07/15(木) 21:05

あるいは、グラフは1個で、
スライサーで、1D、No　を選択して表示を切り替えるのではだめでしょうか

（マナ） 2021/07/15(木) 21:08

 こんな感じなんですかね

    Sub test()

    Dim FirstRow As Long, LastRow As Long
    Dim LastCol As Long, iC As Long
    Dim ChartPosR As Long, ChartPosC As Long, ChartPos As Range

    LastCol = Cells(2, Columns.Count).End(xlToLeft).Column

    ChartPosR = 0: ChartPosC = 0
    iRow = 3
    Do While Cells(iRow, 2).Value <> ""
       ID = Cells(iRow, 2).Value
       FirstRow = iRow: LastRow = iRow
       Do Until Cells(LastRow + 1, 2).Value <> ID: LastRow = LastRow + 1: Loop

       With Range(FirstRow & ":" & LastRow)
           ChartPosC = 0
           For iC = 6 To LastCol
              Set ChartPos = Cells(ChartPosR * 28 + 2, ChartPosC * 15 + 2).Resize(28, 14)
              MakeLineChart ChartPos, ID & "-" & Cells(2, iC).Value, Cells(2, iC), .Columns(iC), .Columns("D")
              ChartPosC = ChartPosC + 1
           Next
       End With
       iRow = LastRow + 1
       ChartPosR = ChartPosR + 1
    Loop

    End Sub

    Sub MakeLineChart(Anchor As Range, strTitle As String, NameCell As Range, valueRange As Range, xValueRange As Range)
        With Anchor.Worksheet.Shapes.AddChart2(Style:=227, XlChartType:=xlLine, _
             Top:=Anchor.Top, Left:=Anchor.Left, Width:=Anchor.Width, Height:=Anchor.Height).Chart
          .ChartTitle.Text = strTitle
          With .SeriesCollection.NewSeries
             .Name = "=" & NameCell.Address(External:=True)
             .Values = "=" & valueRange.Address(External:=True)
             .XValues = "=" & xValueRange.Address(External:=True)
          End With
        End With
    End Sub

（´・ω・`） 2021/07/16(金) 09:35

書き溜めている間に話が進んでいましたが投稿しておきます。

■１

 たまたまかもしれませんが↓と同じ方だったりしますか？
[[20210713171435]]　『実行時エラー91「オブジェクト変数または With ブロック変数が設定されていません』（hiro）

■２

 VBAで文字列を結合するのに普通は「&」を使います。
 (「+」で結合することも出来はしますが、まぎらわしいので避けた方が無難に思います。)

■３

 ↓はどの【シート】なのか指定した方がよいとおもいます。(シートモジュールに書いているなら別ですが）
 Range("B" & ((i - 2) * 28 + 2)).Top
 Range("B" & ((i - 2) * 15 + 2)).Left

■４

 Sub～End Subまでがひとかたまりなので、提示するならはじめから終わりまで提示されたほうが
 回答者側で状況がつかみやすくなり回答率がアップすると思います
 付随して「sh」「First_Row」「Lost_Row」はどこで設定（取得）しているのですか？

 また、全体的にインデントがついておらず見づらいです。
 こだわりがなければ、インデントを付けるようにした方がよいでしょう。
 （ご自身がデバッグ作業する際の効率アップにもつながるとおもいます）

 試していませんが、上記を踏まえて整理するとこんな感じになりませんか？

    Sub 名も無きマクロ()
        Dim x As Long, i As Long
        Dim strJoin As String
        Dim MyRNG As Range

        With Worksheets("○○○")

            x = 6
            For i = 2 To .Cells(2, .Columns.Count).End(xlToLeft).Column
                strJoin = Str & .Cells(2, 2).Text & " " & .Cells(1, x).Text
                Set MyRNG = Intersect(.Rows(First_Row & ":" & Lost_Row), .Union(.Range("D1"), .Cells(1, x).EntireColumn))

                With ActiveSheet.Shapes.AddChart.Chart
                    .ChartType = xlLine                           'グラフ種類
                    .SetSourceData Source:=MyRNG      'グラフ範囲指定
                    .HasTitle = True                                'グラフタイトル表示
                    .ChartTitle.Text = strJoin                   'タイトル文字列設定
                    .Parent.Top = ActiveSheet.Range("B" & ((i - 2) * 28 + 2)).Top 'グラフ位置の設定
                    .Parent.Left = ActiveSheet.Range("B" & ((i - 2) * 15 + 2)).Left 'グラフ位置の設定
                End With

                x = x + 1
            Next i

    End Sub

（もこな２） 2021/07/16(金) 10:31

雛形（案）で書いてみました。
邪魔なら非表示シートでもよいです。
グラフの細かい設定は、手作業で雛形を修正すればよいです。

 Sub test()
    Dim tbl As Range
    Dim wsT As Worksheet    'Template
    Dim wsG As Worksheet    'Graph
    Dim cho As ChartObject
    Dim H As Double, w As Double
    Dim dX As Long, dY As Long
    Dim j As Long, k As Long
    Dim rX As Range, rY As Range
    Dim sz As Long
    Dim myID As String, myNo As String

    Set tbl = Sheets("データ").Cells(1).CurrentRegion
    Set tbl = Intersect(tbl, tbl.Offset(1, 3))  '★D2から
    Set wsT = Sheets("雛形")
    Set wsG = Worksheets.Add

    wsT.ChartObjects(1).Duplicate.Chart _
        .Location xlLocationAsObject, wsG.Name
    Set cho = wsG.ChartObjects(1)
    H = cho.Height
    w = cho.Width
    '★グラフ表示間隔
    dX = 20
    dY = 10
    '★24行ごとにグラフ表示
    sz = 24

    For j = 0 To tbl.Rows.Count / sz - 1
        Set rX = tbl.Columns(1).Resize(sz).Offset(j * sz)
        myID = rX.Cells(1, -1).Value

        For k = 0 To tbl.Columns.Count - 3
            Set rY = rX.Columns(k + 3)
            myNo = rY.EntireColumn.Cells(1).Value

            With cho.Duplicate
                .Chart.SetSourceData Union(rX, rY)
                .Chart.ChartTitle.Text = myID & "_" & myNo
                .Top = j * (H + dY) + dY
                .Left = k * (w + dX) + dX
            End With
        Next
    Next

    cho.Delete

 End Sub

（マナ） 2021/07/16(金) 17:33

修正

 ＞myNo = rY.EntireColumn.Cells(1).Value
     ↓
   myNo = tbl.Columns(k + 3).Cells(0).Value

（マナ） 2021/07/16(金) 17:44

ご挨拶が遅れて申し訳ありませんでした。
ご教示ありがとうございました。
（タム） 2021/08/02(月) 21:26

コメント返信：

[ 一覧(最新更新順) ]

[[20210715095352]] 『VBAでグラフの範囲を変更しながら、連続作成』（タム） ページの最後に飛ぶ

[[20210715095352]]　『VBAでグラフの範囲を変更しながら、連続作成』（タム）　ページの最後に飛ぶ