任意にデータの範囲を選択し、グラフを描画したい
質問を閲覧していただきありがとうございます。
できればみなさんのお力を貸していただきたいことがあり、質問しました。
以下にマクロ作成に用いたプログラムの仕様とコードを貼りますので、ご指摘等いただけましたら幸いです。
まず、今回のマクロの目的は
・既に存在するエクセルデータから、x軸、y軸のデータ列の長さに応じたグラフを描画するVBプログラムを書く事 です。
・可能ならば、既存のふたつのグラフを結合したものを新しく表示する
※データシートの画像は添付しましたのでご覧ください。
以上のふたつとなります。
理想形としては、
A2 ~ A1025までをｘ軸のデータ、B2~B1025までの実データ値としたグラフAを一つ
D2 ~ E1025までをｘ軸のデータ、E2~E1025までの実データ値としたグラフBを一つ
上記二つのグラフを結合したグラフを一つ
の３つのグラフが自動的に作成され、エクセルファイル上に表示されている といったような感じです。
私の書いたコードの問題点としては、
・グラフAグラフBともに「ｘ軸と実データが正しく対応していない」
→本来両方のグラフにおいてはグラフの右端まで折れ線グラフが続いているはずですが、ｘ軸の値にして約１０００の所でデータが終わってしまっています。
・グラフBでは、D2 ~ D344, E2 ~ E344 を基にしたグラフ一つのみが描画されているはずですが、ここには何故か二つ以上の折れ線グラフがあるようにみえ、グラフB右には系列１～５までがあるように書かれています。（理想としては５個ではなく実データを示すもの一つのみ）
・ふたつのグラフの結合方法が不明
という感じです。
以下にプログラムを貼ります。
お時間ありましたら、ご指摘の程宜しくお願い致します。
～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～
Sub グラフ描画()
chart_title1 = "グラフA"
chart_title2 = "グラフB"
'軸のタイトル
x_title = "周波数[Hz]"
y_title = "パワー"
' -------------------------グラフ作成----------------------
' グラフを描画
Dim chartObj1 As ChartObject
Set chartObj1 = ActiveSheet.ChartObjects.Add(1, 1, 300, 200)
With chartObj1.Chart
' データ範囲をセット
.SetSourceData Source:=Range(Range("B2"), _
Cells(2, 1).End(xlDown))
' x軸の項目軸範囲をセット
.SeriesCollection(1).XValues = Range(Range("A2"), _
Cells(1, 1).End(xlDown))
' オプションをセット
.ChartType = xlXYScatterSmoothNoMarkers ' 散布図
.HasTitle = True
.ChartTitle.Characters.Text = chart_title
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = x_title
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = y_title
' x軸の最大値、最小値設定
.Axes(xlCategory, xlPrimary).MinimumScale = 0
.Axes(xlCategory, xlPrimary).MaximumScale = 4500
' y軸の最大値、最小値設定
.Axes(xlValue).MinimumScale = -10
.Axes(xlValue).MaximumScale = 3
End With
Dim chartObj2 As ChartObject
Set chartObj2 = ActiveSheet.ChartObjects.Add(1, 320, 300, 200)
With chartObj2.Chart
' データ範囲をセット
.SetSourceData Source:=Range(Range("E2"), _
Cells(2, 1).End(xlDown))
' x軸の項目軸範囲をセット
.SeriesCollection(1).XValues = Range(Range("D2"), _
Cells(1, 1).End(xlDown))
' オプションをセット
.ChartType = xlXYScatterSmoothNoMarkers ' 散布図
.HasTitle = True
.ChartTitle.Characters.Text = chart_title
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = x_title
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = y_title
' x軸の最大値、最小値設定
.Axes(xlCategory, xlPrimary).MinimumScale = 0
.Axes(xlCategory, xlPrimary).MaximumScale = 4500
' y軸の最大値、最小値設定
.Axes(xlValue).MinimumScale = -10
.Axes(xlValue).MaximumScale = 3
End With
End Sub
～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～
お礼
ありがとうございます。 装置レベルでの状態検査の実績はあり、 おっしゃるとおりの内容で出来たのですが 工具レベル（ハンディータイプ）の物を探していました。