アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

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

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

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

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

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

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

A 回答 (1件)

'考え方としては、ベースになる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
      
      '横×1列配置の場合はTのみ
      T = T + H + 10 '10は間隔
      
      '横×3列配置の場合
      '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
    • good
    • 0

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