Question

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

我正在考虑使用某些方法来制作我的宏，但是当我尝试制作它时，我明白这对我来说太难了，我会头疼。

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

以下是重叠数据标签的示例图表：

enter image description here

以下是我手动修复数据标签的示例图表：

enter image description here

Answer 1

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

对于给定的样品，将所有系列绘制在共同的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

检测重叠

这会使用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（并且，可能是之前的版本）没有。

Answer 2

当数据源列在两个相邻的列中时，此宏将阻止2个折线图上的重叠标记。

Attribute VB_Name = "DataLabel_Location"
Option Explicit


Sub DataLabel_Location()
'
'
' *******move data label above or below line graph depending or other line graphs in same chart***********

Dim Start As Integer, ColStart As String, ColStart1 As String
Dim RowStart As Integer, Num As Integer, x As Integer, Cell As Integer, RowEnd As Integer

Dim Chart As String, Value1 As Single, String1 As String


Dim Mycolumn As Integer
Dim Ans As String
Dim ChartNum As Integer



   Ans = MsgBox("Was first data point selected?", vbYesNo)
    Select Case Ans
    Case vbNo
    MsgBox "Select first data pt then restart macro."
    Exit Sub

    End Select

     On Error Resume Next


ChartNum = InputBox("Please enter Chart #")
    Chart = "Chart " & ChartNum
ActiveSheet.Select

ActiveCell.Select


RowStart = Selection.row
ColStart = Selection.Column
ColStart1 = ColStart + 1
ColStart = ColNumToLet(Selection.Column)
RowEnd = ActiveCell.End(xlDown).row
ColStart1 = ColNumToLet(ActiveCell.Offset(0, 1).Column)

Num = RowEnd - RowStart + 1


With ThisWorkbook.ActiveSheet.Select
    ActiveSheet.ChartObjects(Chart).Activate
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(2).ApplyDataLabels
End With

    For x = 1 To Num

           Value1 = Range(ColStart & RowStart).Value
           String1 = Range(ColStart1 & RowStart).Value


        If Value1 = 0 Then
            ActiveSheet.ChartObjects(Chart).Activate
            ActiveChart.SeriesCollection(1).DataLabels(x).Select
            Selection.Delete
        End If

        If String1 = 0 Then
            ActiveSheet.ChartObjects(Chart).Activate
            ActiveChart.SeriesCollection(2).DataLabels(x).Select
            Selection.Delete
        End If


        If Value1 <= String1 Then



            ActiveSheet.ChartObjects("Chart").Activate

            ActiveChart.SeriesCollection(1).DataLabels(x).Select
            Selection.Position = xlLabelPositionBelow
            ActiveChart.SeriesCollection(2).DataLabels(x).Select
            Selection.Position = xlLabelPositionAbove




        Else
            ActiveSheet.ChartObjects("Chart").Activate
            ActiveChart.SeriesCollection(1).DataLabels(x).Select
            Selection.Position = xlLabelPositionAbove
            ActiveChart.SeriesCollection(2).DataLabels(x).Select
            Selection.Position = xlLabelPositionBelow

        End If
            RowStart = RowStart + 1
    Next x

End Sub

'
' convert column # to column letters
'
Function ColNumToLet(Mycolumn As Integer) As String
  If Mycolumn > 26 Then
    ColNumToLet = Chr(Int((Mycolumn - 1) / 26) + 64) & Chr(((Mycolumn - 1) Mod 26) + 65)
  Else
    ColNumToLet = Chr(Mycolumn + 64)
  End If
End Function

Answer 3

@chris neilsen 你能在Excel 2007上测试你的解决方案吗？当我将对象转换为DataLabel类时，看起来已经从类中删除了.Width属性。（对不起，我不允许对你的回复发表评论）

也许从论坛下面添加一件事就是临时调整标签的位置： http://www.ozgrid.com/forum/showthread.php?t=90439 “通过强制标签离开图表并将报告的左/顶值与宽度/高度内的图表区域进行比较，您可以获得数据标签的接近宽度或高度值。”

基于此，请移动v（i）.Width＆amp; v（j）。宽度变量sng_vi_Width＆amp; sng_vj_Width并添加这些行

With v(i)
 sngOriginalLeft = .Left 
 .Left = .Parent.Parent.Parent.Parent.ChartArea.Width 
 sng_vi_Width = .Parent.Parent.Parent.Parent.ChartArea.Width - .Left 
 .Left = sngOriginalLeft 
End With
With v(j)
 sngOriginalLeft = .Left 
 .Left = .Parent.Parent.Parent.Parent.ChartArea.Width 
 sng_vj_Width = .Parent.Parent.Parent.Parent.ChartArea.Width - .Left 
 .Left = sngOriginalLeft 
End With

Answer 4

尽管我同意常规Excel公式无法解决所有问题，但我不喜欢VBA。这有几个原因，但最重要的原因是它可能会停止下一次升级。我并不是说你根本不应该使用VBA，而只是在必要时使用它。

你的问题是一个很好的例子，需要VBA是不必要的......“好的”你说，“但那我该如何解决这个问题呢？”感到很幸运，点击此链接可以回答我对相关问题的回答here。

您将在链接中找到的内容是，如何衡量图表的确切网格。当x轴与0交叉时，您只需要最大的Y轴标签。你现在只有一半，因为你的具体问题还没有解决。以下是我将如何继续：

首先测量标签与图表高度的比较高度。这需要一些试验和错误，但不应该非常困难。如果您的图表可以堆叠20个标签而不重叠，则该数字例如为0.05。

接下来确定任何标签是否以及在何处重叠。这很容易，因为您需要做的就是找出数字彼此过于接近的位置（在我的示例中在0.05范围内）。

使用一些布尔测试或所有我关心的IF公式来查找。你得到的结果是一个表格，其中包含每个系列的答案（第一个除外）。不要害怕在下一步中再次复制该表：创建新的图表输入。

有几种方法可以创建新图表，但这是我选择的图表。为每个系列创建三行。一个是实际线，另外两个是只有数据标签的不可见线。对于每条线，只有一条看不见的线，只有常规标签。这些都使用相同的对齐方式。每条额外的隐形线都有不同的标签对齐方式。第一个系列你不需要一个，但是第二个系列你需要一个标签，右边是第三个，左边是第四个（例如）。

当没有数据标签只重叠第一条不可见的线条（具有常规对齐）时，需要显示这些值。当标签重叠时，相应的额外不可见线应该接管该点并显示其标签。当然第一条看不见的线不应该出现在那里。

当所有四个标签在相同的x轴值重叠时，您应该看到第一个基本不可见线的标签和三个额外的不可见线标签。这应该适用于您的示例图表，因为有足够的空间可以向左右移动标签。就个人而言，我只坚持在重叠点处的最小和最大标签，因为它重叠的事实表明这些值在第一时间彼此非常接近..

我希望这能帮到你，

问候，

帕特里克

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

4 个答案:

访问标签

检测重叠

移动标签

关于Excel的注释