Excel宏来修复折线图中的重叠数据标签

Question

我正在搜索/尝试制作一个宏来修复具有一个或多个系列集合的折线图中数据标签的位置,以便它们不会相互重叠.

我正在为我的宏思考一些方法,但当我尝试制作它时,我明白这对我来说太难了,我会头疼.

有什么我错过的吗？你知道这样的宏吗？

这是一个带有重叠数据标签的示例图表:

这是我手动修复数据标签的示例图表:

Answer 1

这个任务基本上分解为两个步骤:访问的Chart对象来获取Labels,并操纵的标签位置,避免重叠.

对于给定的样品,将所有系列绘制在共同的X轴上,并且X值充分展开,使得标签在该维度上不重叠.因此,所提供的解决方案仅依次处理每个X点的标签组.

访问标签

这Sub将解析图表并Labels依次为每个X点创建一个数组

Sub MoveLabels()
    Dim sh As Worksheet
    Dim ch As Chart
    Dim sers As SeriesCollection
    Dim ser As Series
    Dim i As Long, pt As Long
    Dim dLabels() As DataLabel

    Set sh = ActiveSheet
    Set ch = sh.ChartObjects("Chart 1").Chart
    Set sers = ch.SeriesCollection

    ReDim dLabels(1 To sers.Count)
    For pt = 1 To sers(1).Points.Count
        For i = 1 To sers.Count
            Set dLabels(i) = sers(i).Points(pt).DataLabel
        Next
        AdjustLabels dLabels  ' This Sub is to deal with the overlaps
    Next
End Sub

检测重叠

这调用AdjustLables一个数组Labels.需要检查这些标签的重叠

Sub AdjustLabels(ByRef v() As DataLabel)
    Dim i As Long, j As Long

    For i = LBound(v) To UBound(v) - 1
    For j = LBound(v) + 1 To UBound(v)
        If v(i).Left <= v(j).Left Then
            If v(i).Top <= v(j).Top Then
                If (v(j).Top - v(i).Top) < v(i).Height _
                And (v(j).Left - v(i).Left) < v(i).Width Then
                    ' Overlap!

                End If
            Else
                If (v(i).Top - v(j).Top) < v(j).Height _
                And (v(j).Left - v(i).Left) < v(i).Width Then
                    ' Overlap!

                End If
            End If
        Else
            If v(i).Top <= v(j).Top Then
                If (v(j).Top - v(i).Top) < v(i).Height _
                And (v(i).Left - v(j).Left) < v(j).Width Then
                    ' Overlap!

                End If
            Else
                If (v(i).Top - v(j).Top) < v(j).Height _
                And (v(i).Left - v(j).Left) < v(j).Width Then
                    ' Overlap!

                End If
            End If
        End If
    Next j, i
End Sub

移动标签

检测到重叠时,您需要一种策略来移动一个或两个标签而不会创建另一个重叠.
这里有很多可能性,你有足够的细节来判断你的要求.

关于Excel的注意事项

要使用此方法,您需要具有DataLabel.Width和DataLabel.Height属性的Excel版本.版本2003 SP2(并且,可能是,之前的版本)没有.