棒グラフのデータラベルの位置

Question

Excel2007で作成した棒グラフのデータラベルの位置なのですが、同じくらいのパーセンテージが並ぶと重なってしまって全く見えません。手作業でいつも補正しているのですが、VBAなどプログラムを使うことで簡単に補正できるようになるものでしょうか。できるのであれば技術者の派遣をお願いするなどして対応したいと思っているのですが、VBAでそもそもどこまでできるのかも分からないため、お分かりになる方ご教示いただけますと助かります。
よろしくお願いいたします。

imogasi · Accepted Answer

どういうロジック（ルール）で、どうずらすか、個別でなく、ルールを作れるなら、それを考えないとダメでしょう。
それは技術者だから優れたアイデアが出るとは限らないように思う。
又どんな場合にも通用するルールというのも考えにくいように思いますですが。
そのアイデアを文章表現して、（別）質問すれば、簡単なルールなら、あるいはＶＢＡで実現（回答）してくれるかも知れません。
（１）ラベル文字方向に角度を付ける
（２）上下位置を互い違いにする(原初位置より、一定数だけプラスとマイナスを繰返す）
などのようなことです。
後者は
Sub Macro4()
   For i = 1 To ActiveChart.SeriesCollection(1).Points.Count
    ActiveChart.SeriesCollection(1).Points(i).DataLabel.Select
    If i Mod 2 = 0 Then '偶数番、奇数番目で表示位置上下に差をつける
    Selection.Top = Selection.Top + 10
    Else
    Selection.Top = Selection.Top - 10
    End If
  Next i
End Sub
上記は私の思いつきで、データの有様によっては、見やすくなるとは限らないことも判るのですが。

xls88 · Answer

下記コードを試してください。
対象グラフを選択して置いて実行してください。
系列数が1つの場合です。
系列が複数ある場合はもう少し考えなければいけません。

データラベルはWidth,Heightが取れません。
重なり量の計算にFont.Sizeを代用しています。
移動量はラベルの余白を考慮して補正値を0.7で入れてあります。

Dim fsize As Variant
    Dim dlbtop1 As Variant
    Dim dlbtop2 As Variant
    Dim i As Long
    
    With ActiveChart.SeriesCollection(1)
        'ラベル初期化
        .DataLabels.Delete
        .HasDataLabels = True
        Application.ScreenUpdating = True
        
        fsize = .DataLabels.Font.Size
        For i = 1 To .Points.Count - 1
            dlbtop1 = .Points(i).DataLabel.Top
            dlbtop2 = .Points(i + 1).DataLabel.Top
            If Abs(dlbtop1 - dlbtop2) < fsize Then
                With .Points(i + 1).DataLabel
                    If dlbtop1 < dlbtop2 Then
                        .Top = .Top + (fsize - (dlbtop2 - dlbtop1)) * 0.7
                    Else
                        .Top = .Top - (fsize - (dlbtop1 - dlbtop2)) * 0.7
                    End If
                End With
                'ラベル移動完了までの時間稼ぎ
                Application.Wait Now + TimeValue("00:00:01")
            End If
        Next
    End With

CoalTar · Answer

たぶん、重なった時の処理方法を明確にできれば、対応できると思います
以下は、処理できるか否か程度の試験的マクロ(使い物にならない)
Sub Macro1()
Dim n As Byte
 　　 'ActiveSheet.ChartObjects("グラフ 3").Activate
With ActiveChart.SeriesCollection(1)
For n = 1 To 9
 　　 '下記の内容を検討する必要がある
 　　 If Abs(.Points(n).DataLabel.Top - .Points(n + 1).DataLabel.Top) < 20 Then
 　　 .Points(n + 1).DataLabel.Top = .Points(n + 1).DataLabel.Top - 10
 　　 End If
Next n
End With
End Sub
結果は添付図

棒グラフのデータラベルの位置

どういうロジック（ルール）で、どうずらすか、個別でなく、ルールを作れるなら、それを考えないとダメでしょう。

下記コードを試してください。

たぶん、重なった時の処理方法を明確にできれば、対応できると思います

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング