excel泡泡图重叠数据标签

当下表中的criteria1和criteria2具有相同的值时，我正面临着气泡图的问题。 数据标签和数据系列相互重叠。 在这种情况下，很难阅读。 这怎么解决？

 +------------+-----------+-----------+ | City | criteria1 | criteria2 | +------------+-----------+-----------+ | Thane | 4 | 3 | | Mumbai | 3 | 2 | | Pune | 5 | 1 | | Goa | 2 | 3 | | Chandigarh | 3 | 1 | +------------+-----------+-----------+ 

重叠的问题

Answer 1

您可以：

1. select一个数据标签 。 点击任何数据标签，就会select一组数据标签。 再次点击该组的任何数据标签，它将select该特定的标签。 或者点击图表中的任何对象，然后使用左/右箭头更改select，直到您select了感兴趣的标签。*
2. 移动它 。 单击并拖动。

请参阅https://stackoverflow.com/a/27813339/2707864 （相关）。

对于一个自动化的工作，我build议你得到真棒的XY图表贴标机，并用它作为你的VBA代码的基础。 所需的代码不会太短。 我在这里给你一个原理图：

1. 检测是否有重叠（您不仅要检查完全重合 – 完全重叠，还要检查一些XY框 – 部分重叠）。 您可能需要检测多个完整/部分重叠。 在某些情况下（可能不太可能），这可能相当复杂。 在极端情况下，所有数据点可能形成部分重叠链。
2. 根据上述检测到的情况决定移动标签的algorithm。
3. 使用XY Chart Labeler中的代码来执行移动。

*看看它是如何工作是非常有益的，有时你可以select一个很难/不可能用鼠标select的对象。

Answer 2

添加了调整数据标签的图表旁边的刷新button。 下面是button后面的代码。

  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 resetLabels dLabels AdjustLabels dLabels ' This Sub is to deal with the overlaps Next End Sub Private Sub AdjustLabels(ByRef v() As DataLabel) Application.ScreenUpdating = False Dim i As Long, j As Long, adj As Long Dim temp_a As String, temp_b As String For i = LBound(v) To UBound(v) - 1 For j = LBound(v) + 1 To UBound(v) temp_a = v(i).Caption temp_b = v(j).Caption Debug.Print temp_a & " - | - " & temp_b v(i).Caption = "a" v(j).Caption = IIf(temp_a = temp_b, "a", "b") ActiveSheet.ChartObjects("Chart 1").Activate If ((v(j).Top = v(i).Top) And (v(i).Caption <> v(j).Caption) And (v(j).Left = v(i).Left)) Then Select Case v(j).Position Case xlLabelPositionAbove v(j).Position = xlLabelPositionRight Case xlLabelPositionRight v(j).Position = xlLabelPositionBelow Case xlLabelPositionBelow v(j).Position = xlLabelPositionLeft Case xlLabelPositionLeft v(j).Position = xlLabelPositionAbove End Select End If v(i).Caption = temp_a v(j).Caption = temp_b temp_a = vbNullString temp_b = vbNullString Next j, i Application.ScreenUpdating = True End Sub Sub resetLabels(ByRef v() As DataLabel) For i = LBound(v) To UBound(v) - 1 v(i).Position = xlLabelPositionAbove Next End Sub