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

Question

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

我正在为我的宏考虑一些方法，但是当我尝试实现它时，我明白这对我来说太难了，而且我很头疼。

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

以下是带有重叠数据标签的示例图表:

这是一个示例图表，我在其中手动修复了数据标签:

Answer 1

此任务基本上分为两个步骤:访问Chart对象以获取Labels，以及操作 标签位置以避免重叠。

对于给定的示例，所有系列都绘制在公共(public) X 轴上，并且 X 值充分分布，标签在此维度上不会重叠。因此，提供的解决方案仅依次处理每个 X 点的标签组。

访问标签

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

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

检测重叠

这会使用Labels数组调用AdjustLables。需要检查这些标签是否重叠

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(以及可能更早的版本)没有。