Question

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

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

enter image description here

重叠问题

enter image description here

Answer 1

你可以：

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

见https://stackoverflow.com/a/27813339/2707864（相关）。

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

检测是否存在重叠（您不仅要检查完全重合 - 完全重叠，还要检查某些X-Y盒 - 部分重叠 - ）。您可能需要检测多个完整/部分重叠。在某些情况下（可能不太适合你），这可能非常复杂。在极端情况下，所有数据点都可能形成一系列部分重叠。
根据上面检测到的情况，确定移动标签的算法。
使用 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

excel气泡图重叠数据标签

2 个答案: