vba - excel气泡图重叠数据标签

Question

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

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

重叠问题

Answer 1

你可以：

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

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

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

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

* 看看它是如何工作的很有启发性，有时您可以选择一个用鼠标很难/不可能选择的对象。

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