複数のグラフを整列させて表示する方法

質問

現在、複数のグラフを作成するマクロを作っています（ちなみに、今日はじめてマクロを用いたグラフ作成に取り組みました）。

それぞれの行に１３個のデータが入っていて（平均値と標準偏差がそれぞれ入っている）、それを用いて行ごとにグラフを作成します。

データが格納されている行はだいたい３００個くらいなのですが、今のままだと３００のグラフがすべて重ねられた状態で出てきます。

これを整列した状態で表示させたいのですが、どのようにすればよいのでしょうか？

あと、今回はほとんど「マクロの記録」で作ったので、なんかソースが汚ないのでもう少し綺麗にならないでしょうか？

下にソースをのせておきます。よろしくお願いします。

Sub Macro6()
'
' Macro6 Macro
'

'
Dim x As Long

Cells(1, 1).Select
x = Range(Selection, Selection.End(xlDown)).Rows.Count

For i = 2 To x

Range(Cells(i, 2), Cells(i, 14)).Select 'これがないと棒どうしが密着したグラフになる。

ActiveSheet.Shapes.AddChart.Select

'データの範囲を指定
ActiveChart.SetSourceData Source:=Range(Cells(i, 2), Cells(i, 14))

'エラーバーをつける
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SeriesCollection(1).HasErrorBars = True
ActiveChart.SeriesCollection(1).ErrorBar Direction:=xlY, Include:=xlErrorBarIncludeBoth, Type:=xlErrorBarTypeCustom, Amount:=Range(Cells(i, 15), Cells(i, 27)), MinusValues:=Range(Cells(i, 15), Cells(i, 27))

'Legendを消す
ActiveChart.Legend.Select
Selection.Delete

'タイトルや軸ラベルの名前を変更する
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = Cells(i, 1)

ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
ActiveChart.Axes(xlCategory, xlPrimary).axistitle.Text = "Class"
ActiveChart.Axes(xlCategory, xlPrimary).axistitle.Font.Size = 14

ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
ActiveChart.Axes(xlValue, xlPrimary).axistitle.Text = "Intensity"
ActiveChart.Axes(xlValue, xlPrimary).axistitle.Font.Size = 14

Next i

End Sub

回答No.1

end-u

'考え方としては、ベースになるChartをまず作成して必要分コピーする。
Sub test()
　　Const W As Single = 300 'ベースChartのWidth(固定)
　　Const H As Single = 180 'Height(固定)
　　Dim L　 As Single　　　 'Left(変動)
　　Dim T　 As Single　　　 'Top(変動)
　　Dim ws　As Worksheet　　'処理シート
　　Dim c　 As ChartObject　'ベースChart用
　　Dim r　 As Range　　　　'SourceData用
　　Dim x　 As Long
　　Dim i　 As Long

　　With ActiveSheet
　　　　x = .Cells(1, 1).End(xlDown).Row
　　　　If IsEmpty(.Cells(x, 1).Value) Then Exit Sub
　　End With

　　Set ws = ActiveSheet
　　Set c = ws.ChartObjects.Add(L, T, W, H)
　　With c.Chart
　　　　.ChartType = xlColumnClustered
　　　　.SeriesCollection.NewSeries
　　　　.HasTitle = True
　　　　.HasLegend = False
　　　　With .Axes(xlCategory, xlPrimary)
　　　　　　.HasTitle = True
　　　　　　.AxisTitle.Text = "Class"
　　　　　　.AxisTitle.Font.Size = 14
　　　　End With
　　　　With .Axes(xlValue, xlPrimary)
　　　　　　.HasTitle = True
　　　　　　.AxisTitle.Text = "Intensity"
　　　　　　.AxisTitle.Font.Size = 14
　　　　End With
　　　　.SetElement (msoElementChartTitleAboveChart)
　　　　.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
　　　　.SetElement (msoElementPrimaryValueAxisTitleRotated)
　　End With

　　L = 0
　　T = 0

　　For i = 2 To x
　　　　Set r = ws.Cells(i, 2).Resize(, 13)
　　　　With c.Duplicate
　　　　　　.Left = L
　　　　　　.Top = T

　　　　　　'横×１列配置の場合はTのみ
　　　　　　T = T + H + 10 '10は間隔

　　　　　　'横×３列配置の場合
　　　　　　'If (i Mod 3) = 1 Then
　　　　　　'　　L = 0
　　　　　　'　　T = T + H + 10
　　　　　　'Else
　　　　　　'　　L = L + W + 10
　　　　　　'End If

　　　　　　With .Chart
　　　　　　　　.ChartTitle.Text = ws.Cells(i, 1).Value
　　　　　　　　.SetSourceData Source:=r
　　　　　　　　.SeriesCollection(1).ErrorBar Direction:=xlY, _
　　　　　　　　　　　　　　　　　　　　　　　Include:=xlErrorBarIncludeBoth, _
　　　　　　　　　　　　　　　　　　　　　　　Type:=xlErrorBarTypeCustom, _
　　　　　　　　　　　　　　　　　　　　　　　Amount:=r.Offset(, 13), _
　　　　　　　　　　　　　　　　　　　　　　　MinusValues:=r.Offset(, 13)
　　　　　　End With
　　　　End With
　　Next
　　c.Delete

　　Set r = Nothing
　　Set c = Nothing
　　Set ws = Nothing
End Sub

こんな感じですが、300くらいのグラフを作成するとなると、
ちょっと重くなって描画にも負担がかかるような？

まとめて印刷するような用途でなければ、グラフを画面表示可能な数だけ作成しておいて、
元データのほうを入れ替えるような仕様もありかもしれませんね。

元データ入れ替えは、マクロを使ったり、数式をセットした作業セルを使ったり
などいろいろ考えられると思います。
http://oshiete1.goo.ne.jp/qa5524597.html