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

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

我正在考虑macros的一些方法，但是当我试图做到这一点时，我明白这对我来说太难了，我很头痛。

有什么我错过了吗？ 你知道这样一个macros吗？

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

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

Answer 1

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

对于给定所有系列的样品都绘制在一个共同的X轴上，并且X值足够分散，标签在这个维度上不重叠。 因此，所提供的解决scheme仅依次处理每个X点的标签组。

访问标签

这个Subparsing图表，并依次为每个X点创build一个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 

移动标签

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

关于Excel的说明

要使用这种方法，您需要具有DataLabel.Width和DataLabel.Height属性的Excel版本。 版本2003 SP2（以及可能更早）不会。

Answer 2

当两个相邻列中列出数据源时，此macros将防止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

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

你的问题就是VBA没有必要的一个很好的例子。“OK”你说，“但是我怎么解决这个问题呢？ 感到幸运，点击这个链接到我的答案在这里相关的问题。

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

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

接下来确定是否和在哪里的标签将重叠。 这很容易，因为所有你需要做的是找出数字相互之间太接近（在我的例子中的0.05范围内）。

使用一些布尔testing或所有我关心IF公式来找出。 你所追求的结果是每个系列（第一个除外）的答案。 不要害怕在下一步中再次复制该表格：创build新的图表input。

有几种方法来创build新的图表，但这是我select的。 为每个系列创build三条线。 一个是实际的行，另外两个是只有数据标签的不可见行。 对于每一条线，都有一条只有普通标签的无形线条。 那些都使用相同的路线。 每个额外的不可见线对于标签具有不同的alignment方式。 第一个系列不需要一个标签，而第二个系列的标签会在右侧，第三个在下面，第四个在左侧（例如）。

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

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

我希望这对你有帮助，

问候，

帕特里克

Answer 4

@chris neilsen你可以在Excel 2007上testing你的解决scheme吗？ 当我将对象转换为DataLabel类时，它看起来像.Width属性已经从类中移除。 （对不起，我不能评论你的回复）

也许有一件事从下面的论坛添加是临时调整标签的位置： http : //www.ozgrid.com/forum/showthread.php? t= 90439 “你通过强迫的数据标签接近宽度或高度值从图表中标出，并将报告的左/顶部值与chartarea内部的宽度/高度值进行比较。

基于此，请将v（i）.Width＆v（j）.Width移动到variablessng_vi_Width＆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