*** Excel VBAで散布図を書いてみた ***

 きょうまで遅めの夏休みで、6連休でした。
 休みのうちに台風16号は温帯低気圧に変わり、東へ抜け――。
 台風17号の接近までに少し間があるので、あすはリハビリ日和になりそうな感じ。

 シフト業務の間にほかの仕事を進められそうですが、間が空いてしまったので、忘れかけてます。。
 ・・・ということで、先週作ったマクロを少し復習中。また改良しないといけないので・・・。

 やりたいことは、モデルの高層予想気温と実況の降水量・天気のデータセットを――。
 (C列~J列は500~950hPaの気温、K列は降水量、L列は地上気温、M列は天気。シート名は"data")

画像

 雨・みぞれ・雪の行だけを抽出して並び替え、それをもとに散布図を作成すること。
 縦軸は実況の降水量、横軸は高層予想気温で、雨・みぞれ・雪で色を変えて表示したい――。

 先々週までは、フィルターをかけて、天気「雨」の行を別シートにコピペ→天気「みぞれ」の行をコピペ→天気「雪」の行をコピペの後、雨・みぞれ・雪の設定範囲を変更し、散布図を作成――という方法でしたが、あまりに時間がかかり非効率。おまけに出来た散布図の縦軸・横軸がデータ範囲によってバラバラ・・・。
 ストレスがたまるので、何とかしないと・・・ということで、ネットであれこれ漁って、何とか動かせました。。

画像

 まずは前回作成したグラフを削除――。

-------------------------------------------------------------------------
 Sheets("result").Select

 With ActiveSheet
 For i = .ChartObjects.Count To 1 Step -1
  .ChartObjects(i).Delete
 Next i
 End With

-------------------------------------------------------------------------

 次に"data"のデータから雨・みぞれ・雪を含む行を"result"にコピペする部分――。

-------------------------------------------------------------------------
Sheets("data").Select

p1 = 0: p2 = 0: p3 = 0 '雨・みぞれ・雪の個数のリセット

kkk = ActiveSheet.Range("a3").End(xlDown).Row

For i = 3 To kkk
Sheets("data").Select
If Cells(i, 13) = "雨" Then
p1 = p1 + 1
Range(Cells(i, 1), Cells(i, 13)).Select
Selection.Copy

Sheets("result").Select
Cells(p1, 1).Select
ActiveSheet.Paste
End If
Next i

For i = 3 To kkk
Sheets("data").Select
If Cells(i, 13) = "みぞれ" Then
p2 = p2 + 1
Range(Cells(i, 1), Cells(i, 13)).Select
Selection.Copy

Sheets("result").Select
Cells(p1 + p2, 1).Select
ActiveSheet.Paste
End If
Next i

For i = 3 To kkk
Sheets("data").Select
If Cells(i, 13) = "雪" Then
p3 = p3 + 1
Range(Cells(i, 1), Cells(i, 13)).Select
Selection.Copy

Sheets("result").Select
Cells(p1 + p2 + p3, 1).Select
ActiveSheet.Paste
End If
Next i

-------------------------------------------------------------------------

 で、問題の散布図を描画する部分――。

-------------------------------------------------------------------------
Dim x_max(10), x_min(10) As Single

Sheets("result").Select

For j = 1 To 8 '気圧面ループ 始まり

ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatter

ActiveSheet.ChartObjects(j).Width = 200
ActiveSheet.ChartObjects(j).Height = 150

With ActiveSheet.ChartObjects(j)
If j <= 2 Then
.Top = Cells(2, 4 * j + 10).Top
.Left = Cells(2, 4 * j + 10).Left
ElseIf j <= 5 Then
.Top = Cells(14, 4 * j + 2).Top
.Left = Cells(14, 4 * j + 2).Left
Else
.Top = Cells(26, 4 * j - 10).Top
.Left = Cells(26, 4 * j - 10).Left
End If
End With

ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).Name = "=""雨"""
ActiveChart.SeriesCollection(1).Values = Range(Cells(1, 11), Cells(p1, 11))
ActiveChart.SeriesCollection(1).XValues = Range(Cells(1, j + 2), Cells(p1, j + 2))

ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""みぞれ"""
ActiveChart.SeriesCollection(2).Values = Range(Cells(p1 + 1, 11), Cells(p1 + p2, 11))
ActiveChart.SeriesCollection(2).XValues = Range(Cells(p1 + 1, j + 2), Cells(p1 + p2, j + 2))

ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Name = "=""雪"""
ActiveChart.SeriesCollection(3).Values = Range(Cells(p1 + p2 + 1, 11), Cells(p1 + p2 + p3, 11))
ActiveChart.SeriesCollection(3).XValues = Range(Cells(p1 + p2 + 1, j + 2), Cells(p1 + p2 + p3, j + 2))

ActiveChart.HasLegend = False '凡例非表示

Dim sc1, sc2, sc3 As Series
Set sc1 = ActiveSheet.ChartObjects(j).Chart.SeriesCollection(1)
Set sc2 = ActiveSheet.ChartObjects(j).Chart.SeriesCollection(2)
Set sc3 = ActiveSheet.ChartObjects(j).Chart.SeriesCollection(3)

'マーカーの色設定
With sc1
.ChartType = xlXYScatter
.MarkerSize = 7
.MarkerBackgroundColor = RGB(0, 0, 256)
.MarkerForegroundColor = RGB(0, 0, 256)
.MarkerStyle = xlMarkerStyleCircle
End With

With sc2
.ChartType = xlXYScatter
.MarkerSize = 7
.MarkerBackgroundColor = RGB(0, 256, 0)
.MarkerForegroundColor = RGB(0, 256, 0)
.MarkerStyle = xlMarkerStyleCircle
End With

With sc3
.ChartType = xlXYScatter
.MarkerSize = 7
.MarkerBackgroundColor = RGB(256, 0, 0)
.MarkerForegroundColor = RGB(256, 0, 0)
.MarkerStyle = xlMarkerStyleCircle
End With

With ActiveSheet.ChartObjects(j).Chart
.axes(xlValue).MinimumScale = 0
.axes(xlValue).MaximumScale = 12
End With

Next j '気圧面ループ 終わり

-------------------------------------------------------------------------

 出来上がった散布図はこんな感じ――。
 何か言えるような、何とも言えないような・・・。
 とりあえず簡単に出来るようになりましたが、問題はこれからです。。

画像

 参考にしたサイトは以下の通り。
 ほかにもありましたが、忘れてしまったので省略。
 あすからぼちぼち思い出します。。

http://www.mrexcel.com/forum/excel-questions/608934-visual-basic-applications-difference-marker-style-line-line-style.html

http://bdastyle.net/tools/correlation-coefficient/page5-scattermatrix.html

http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1397285863

http://d.hatena.ne.jp/arakik10/20130127/p2

この記事へのコメント

この記事へのトラックバック