excel 气泡图重叠数据标签

Question

当下方 table 中的 criteria1 和 criteria2 具有相同的值时，我遇到了气泡图问题。数据标签和数据系列相互重叠。在这种情况下，很难阅读它们。如何解决？

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

重叠问题

Answer 1

您可以：

Select 单个数据标签。单击任何数据标签，它将 select 数据标签集。再次单击该组的任何数据标签，它将 select 该特定标签。或者单击图表中的任何对象，并使用 left/right 箭头更改 select 离子，直到您 select 编辑了感兴趣的标签。*
移动它。单击并拖动。

参见（相关）。

对于自动化工作，我建议您获得很棒的 XY Chart Labeler 并将其用作 VBA 代码的基础。所需的代码不会很短。我这里给大家一张示意图：

检测是否会有重叠（你不仅要检查完全重合-完全重叠-，还要检查某个 X-Y 框内-部分重叠-）。您可能需要检测多个 complete/partial 重叠。在某些情况下（对您来说可能不太可能），这可能会非常复杂。在极端情况下，所有数据点可能形成部分重叠链。
根据上述检测到的情况，确定移动标签的算法。
使用 XY Chart Labeler 中的代码执行移动。

* 看看它是如何工作的很有启发性，有时你可以 select 一个对象，否则用鼠标 difficult/impossible 到 select。

Answer 2

在图表旁边添加了一个刷新按钮，用于调整数据标签。下面是按钮背后的代码。

 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

excel 气泡图重叠数据标签

excel bubble chart overlapping data label

excel

vba

excel-charts