遊び tokidoki 仕事

数学と音楽と教育と遊び

| おしごと - きょういく - がくせい - ゼミ - イベント | すうがく - おんがく - 数理音楽 - DTM - かがく - scratch
| Art - photo - おきにー - Tips - ものもう - あれこれ | About - Top

EXCEL2010の散布図テクニック

講義で必要になったので調べたのだが、EXCEL2007から散布図の各要素にラベルがつかなくなった。
これは明らかに不便だ。EXCEL2003まではあったのに。

かつてはこれに以下のようにラベルをつけてどの点が誰なのか分かるようにできた。

講義前日になってこの事実が明らかとなり、
慌ててwebを探し回ったら microsoft のページにわざわざラベル表示専用のマクロが用意されていた。↓
散布図のデータ ポイントにラベルを追加するマクロ
そんなことするくらいなら、機能削除しなければ良かったのに、と文句言いながらシートに実装。
ただ、ほとんどの学生はマクロなど使ったことが無いはずで、
いちいちマクロ機能を使えるようにEXCELを設定しなおして
マクロを自分で呼び出して実行させる、なんてことしたら混乱の極み。
何とかボタン押すだけでラベル付けられるようにならないかと更にwebを渡り歩く。
で、出来上がったのが以下のマクロ。
これは、散布図を作るであろうシートに「ラベル付け」ボタンを付けておき、
このボタンでマクロを起動するようにしておくと、
そのシート内にあるあらゆるグラフを探し出して(散布図に限らず)
ラベルを付けてくれる。
但し、そんなに賢く作ってなくて、散布図データとして囲った
最初の列の一つ前の列をラベルと認識してしまう。だから上の例でいくと、
算数と理科を囲った場合はその前の列のA,B,Cをラベルにつけてくれるが、
理科と社会を囲うと、その前の算数の点をラベルにしてしまう。
とりあえず、サンプルシート(.xlsで保存してあります。)→110529_scatter.xls
分かる人、この先改良してね。


Sub AttachLabelsToPoints()

'Dimension variables.
Dim Counter As Integer, ChartName As String, xVals As String

Dim intObj As Integer
Dim i As Integer
Dim chart0 As Chart

'アクティブシートのChartObjects数をカウント
intObj = ActiveSheet.ChartObjects.Count

'Disable screen updating while the subroutine is run.
Application.ScreenUpdating = False

'そのシートにあるすべてのグラフをChartとして取得してラベルづけする
For i = 1 To intObj

Set chart0 = ActiveSheet.ChartObjects(i).Chart

'Store the formula for the first series in "xVals".
xVals = chart0.SeriesCollection(1).Formula

'Extract the range for the data from xVals.
xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, _
Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop

'Attach a label to each data point in the chart.
For Counter = 1 To Range(xVals).Cells.Count
chart0.SeriesCollection(1).Points(Counter).HasDataLabel = True
chart0.SeriesCollection(1).Points(Counter).DataLabel.Text = _
Range(xVals).Cells(Counter, 1).Offset(0, -1).Value
Next Counter

Next i

End Sub