问题
I am facing an issue with a bubble chart when criteria1
and criteria2
in the below table have the same values. The data label and data series overlap each other. In such cases making it difficult to read them. How can this be fixed?
+------------+-----------+-----------+
| City | criteria1 | criteria2 |
+------------+-----------+-----------+
| Thane | 4 | 3 |
| Mumbai | 3 | 2 |
| Pune | 5 | 1 |
| Goa | 2 | 3 |
| Chandigarh | 3 | 1 |
+------------+-----------+-----------+

Overlapping issue

回答1:
You can:
- Select a single data label. Click on any data label, and it will select the set of data labels. Click again on any data label of that set, and it will select that specific label. Or click on any object in the chart, and use the left/right arrows to change the selection, until you have selected the label of interest.*
- Move it. Click and drag.
See https://stackoverflow.com/a/27813339/2707864 (related).
For an automated work, I suggest you get the awesome XY Chart Labeler and use it as a basis for your VBA code. The required code will not be short. I give you here a schematics:
- Detect whether there would be an overlap (you have to check not only for exact coincidence-complete overlap-, but within some X-Y box-partial overlap-). You might need to detect multiple complete/partial overlaps. Under some circumstances (perhaps unlikely for you), this might be quite complex. In an extreme case, all data points may form a chain of partial overlaps.
- Decide on an algorithm for moving labels, depending on the detected cases above.
- Use the code in XY Chart Labeler to perform the move.
* It is quite instructive to see how this works, sometimes you would be able to select an object that would be otherwise difficult/impossible to select with the mouse.
回答2:
Added a refresh button next to chart which adjust the data labels. Below is the code behind the 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
来源:https://stackoverflow.com/questions/30294041/excel-bubble-chart-overlapping-data-label