エクセルでよくグラフ化する学生、研究生のための自動グラフ化マクロを作成した
ゼミや研究室の進捗報告、学会発表、論文の執筆など、グラフを作成する場面は研究でたくさんありまよね、
実験で得られたデータをエクセルでグラフ化している人も多いのではないかと思います。
エクセルで作成されるグラフは、学会の要旨や論文のテンプレートにあったものではなく、
毎回文字の大きさなどの仕様を変更するのが面倒だったので、
比較的どの論文の仕様にもあった(理工系しかわかりませんが)、
グラフを自動で作成するマクロを組んでみました。
このマクロを適当なショートカットキーに割り当てれば、
マウスを使わずグラフ化が完結します。
(エクセルでもできますが、とにかくフォーマットが、、論文や発表用には使えない！)
慣れればめちゃめちゃ速くできます。
初投稿です、試しにやってみようかな、くらいのモチベーションで書いてますので、
コードのコメントなどは、リクエストがあったら書いていこうと思います。
この記事の方法以外にも、いろいろなデータ形式(凡例が多い場合、x軸はすべての凡例で同じデータを参照するとき、etc...)用のコードもあるので、
それもリクエストがあればまた記事にしたいと思います。
VBAはこのコードを書くまでは、まったく触れたことがなかったので、
見る人が見ればきったないかと思いますが、
使えればいいや、、精神ですので、、、あたたかく、、、、お願いします。
利用方法
例として、位相が90°ずれた2つの正弦波(sin波、cos波)をグラフ化します。
エクセルには、このようにそれぞれの正弦波で、x軸データ、y軸データを用意します。
今回は、それぞれ360°までのデータを用意しました(上図は5°までですが、実際は360°まであります)。
データが用意できたところでマクロを実行します。
今回は、新しいシートにグラフを作成する仕様にしているので、グラフのシート名を入力します。
英語は適当です。
後ろに移っているグラフも、ほんとにグラフ化されるのかよ。って感じですが、いずれされるので我慢で。
x軸のデータを選択します。エクセルでグラフ化するときのようにセルを選択すれば大丈夫です。
みなさんご存知だとは思いますが、範囲選択したいセルの先頭をクリックして選択した状態で、
Ctrl+Shift+↓ のコマンドで連続したセルの下端まで一気に選択されるの便利ですよね！
このコマンドで0~360°まで一気に選択して、OKクリック(Enterキーでもok)
次に、x軸と同じように、y軸のデータも選択します。選択し、OK
x軸、y軸のデータがそれぞれ選択できたら、次は軸ラベル名の入力です。
今回は、一応角度にしました。正弦波だから時間だろ、とかは思うだけにしてください
次はもうお分かり、y軸の軸ラベル名の入力です。
ちなみに名前の入力は、日本語・英語、両方できるアピールでここでは英語にしてます。
こまったら任意単位にするのはあるあるですかね？
ここは凡例名を入力します。
凡例が1つの場合も凡例名を入力する必要がありますが、
グラフ化されたときに凡例名は非表示になりますので、適当に「あああ」でもなんでも。
凡例1(sin波)の情報(選択した軸データや凡例名)が正しかったか聞かれます。
なくてもいいかと思いますが、意外に使っていて便利だった機能です。
他に凡例があるか聞かれます。凡例が1つのグラフは、ここでいいえをクリックすれば完了です。
今回は、cos波も表示したいので、はいを選択。
2つ目の凡例のx軸データを選択します。
1つ目の凡例と同様に、この後y軸データを選択し、凡例名の入力があります。
3つ以上の凡例がある場合も、同様に追加していきます。
グラフ化したい凡例すべての入力がおわれば、
do you have another siries?
でいいえをクリックすればグラフ化完了です。
こうなります。
ソースコード
Sub Graph_auto_maker()
FontSize = 20
sheetname_main = ActiveSheet.Name
Dim chart1 As Chart
Set chart1 = Charts.Add(Before:=ActiveSheet)
buf = InputBox("Name of new graph sheet")
chart1.Name = buf
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
sheetname = ActiveChart.Name
Sheets(sheetname_main).Select
Select_X_region:
X_region = Select_cellRegion("X")
Sheets(sheetname_main).Select
Range(X_region).Select
Select_Y_region:
Y_region = Select_cellRegion("Y")
Charts(sheetname).Select
With ActiveChart
.ChartArea.Select
.SetSourceData Source:=Range(Y_region)
.FullSeriesCollection(1).XValues = X_region
.ChartArea.Format.Line.Visible = msoFalse
With .PlotArea.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
End With
With .Axes(xlCategory)
.HasTitle = True
buf = InputBox("X axis label")
.AxisTitle.Text = buf
.AxisTitle.Font.Size = FontSize
.AxisTitle.Font.Bold = False
.Format.Line.ForeColor.RGB = RGB(0, 0, 0)
.TickLabels.Font.Size = FontSize
.HasMajorGridlines = False
.MajorTickMark = xlInside
End With
With .Axes(xlValue)
.HasTitle = True
buf = InputBox("Y axis label")
.AxisTitle.Text = buf
.AxisTitle.Font.Size = FontSize
.AxisTitle.Font.Bold = False
.Format.Line.ForeColor.RGB = RGB(0, 0, 0)
.TickLabels.Font.Size = FontSize
.HasMajorGridlines = False
.MajorTickMark = xlInside
End With
buf = InputBox("Name of Siries 1")
.SeriesCollection(1).Name = buf
Language = MsgBox("Was series1 setting correct?", vbYesNo + vbQuestion)
If Language = vbNo Then
GoTo Select_X_region
End If
.Legend.Format.TextFrame2.TextRange.Font.Size = FontSize
.HasTitle = True
.ChartTitle.Delete
End With
i = 2
While True
rc = MsgBox("Do you have another of other siries？", vbYesNo + vbQuestion)
If rc = vbYes Then
Series:
Sheets(sheetname_main).Select
X_region = Select_cellRegion("X")
Sheets(sheetname_main).Select
Range(X_region).Select
Y_region = Select_cellRegion("Y")
Charts(sheetname).Select
Set srs = ActiveChart.SeriesCollection.Add(Y_region)
srs.XValues = Range(X_region)
buf = InputBox("Name of Siries " + Str(i))
srs.Name = buf
Language = MsgBox("Was series" + Str(i) + "setting correct?", vbYesNo + vbQuestion)
If Language = vbNo Then
ActiveChart.SeriesCollection(i).Delete
GoTo Series
End If
i = i + 1
Else
If i = 2 Then
Charts(sheetname).Select
ActiveChart.Legend.Delete
GoTo WhileEnd
Else
GoTo WhileEnd
End If
End If
Wend
WhileEnd:
Charts(sheetname).Select
End Sub