散布図にラベルを追加するマクロ
散布図のポイントにラベルを追加したい
Excelで散布図をかいたときにポイントにラベルを追加したいんですがなかなかうまくいかないので思い悩んだあげくVBAで解決したので、その際のスクリプトをかいたので公開しておきます。
方法を調べていったら、斜めにデータを配置するのがオーソドックスなやりかたみたいですね。ttp://pc.nikkeibp.co.jp/article/NPC/20060628/242035/
使い方と前提条件
マクロ実行時に「セル名を入力を促すダイアログ」が出てきますが、そのときはラベル名の一番最初のセル名を入力してください。この例では、B3を指定するとラベルが自動的に振られます。条件としてテーブルのフォーマットはサンプルのような{ラベル名,X,Y},{ラベル名,Y,X}とかそういう表を前提としています。
ソースコード*1
Public Sub 散布図にラベルを追加する() AttachLabelsToPoint End Sub Private Function AttachLabelsToPoint(Optional labels As range = Nothing) Dim i As Integer, j As Integer If (ActiveChart Is Nothing) Then MsgBox ("アクティブなグラフはありません。" & Chr(10) & Chr(13) & "ラベルを追加するグラフを選んでください。") Exit Function End If ' ラベル開始セルの指定 If (labels Is Nothing) Then On Error Resume Next Set labels = Application.InputBox(Prompt:="ラベル開始セル名を入力してください。例)A1", Type:=8) If (Err.Number <> 0) Then Exit Function End If On Error GoTo 0 End If ' スクリーンの更新をOFF Application.ScreenUpdating = False ' ラベルの記入処理 For i = 1 To ActiveChart.SeriesCollection.Count For j = 1 To ActiveChart.SeriesCollection(i).points.Count ActiveChart.SeriesCollection(i).points(j).HasDataLabel = True ActiveChart.SeriesCollection(i).points(j).DataLabel.Text = labels.Offset(j - 1, 0).Value Next j Next i End Function
追記
- スクリプト修正:セルが選択ない件を修正
*1:にわかVBAerなので突っ込み歓迎