Excel: метки пузырьковой диаграммы - использовать 4-е измерение?

Question

У меня есть набор данных, который имеет 4 измерения - скажем, они следующие:

+------------------------------+
| Type  | Amnt |Price| Quality |
+-------|------|-----|---------+
|  A    |  15  | 4.0 |   3     |
|  B    |  32  | 4.5 |   4     |
|  C    |  35  | 3.8 |   7     |
+------------------------------+

То, что я хочу сделать, это нарисовать пузырьковую диаграмму этих данных в Excel. Я могу с радостью нарисовать график, показывающий цену в сравнении с качеством, и затем я могу измерить размер пузырька в соответствии с суммой. Тем не менее, я не могу найти способ пометить пузырьки с помощью измерения типа. Ярлыки по умолчанию кажутся просто одним из трех измерений, используемых на графике, что мне не очень полезно.

Я знаю, что могу добавить метки данных, а затем вручную переименовать каждую из них, но есть ли способ автоматически использовать 4-е измерение для меток?

Answer 1

Код @ Ланса работает хорошо. У меня просто была проблема с настройкой ChartType, а там отсутствует .Rows(i) при установке BubbleSize

Вот что я придумал:

Sub BubbleLabel_Click()

Dim r As Range

With ActiveSheet.ChartObjects.Add(Left:=100, Width:=375, Top:=75, Height:=225).Chart
  'Sacrifical rows that will be lost
  .SeriesCollection.NewSeries
  .SeriesCollection.NewSeries
  .ChartType = xlBubble3DEffect
  .Legend.Delete

  For Each r In [MakeMeAChart].Rows
    With .SeriesCollection.NewSeries
      .Name = r.Cells(1, 1)
      .XValues = r.Cells(1, 3)
      .Values = r.Cells(1, 4)
      .BubbleSizes = "=" & [MakeMeAChart].Parent.Name & "!" & r.Cells(1, 2).Address(1, 1, xlR1C1)
      .ApplyDataLabels
      .DataLabels.ShowSeriesName = True
      .DataLabels.ShowValue = False
    End With
  Next
End With

End Sub

Answer 2

После того, как вы настроите диаграмму, в которой для каждого пузырька будет указан ряд, названный столбцом «Тип» (что само по себе является большой болью), просто запустите этот код, и он будет помечать их все на основе этого имени серии:

Sub BubbleLabel_Click()

Dim BC As ChartObject
Dim i As Integer

Set BC = ActiveSheet.ChartObjects(1)

For i = 1 To BC.Chart.SeriesCollection.Count

  With BC.Chart.SeriesCollection(i)
    .ApplyDataLabels
    .DataLabels.ShowSeriesName = True
    .DataLabels.ShowValue = False
  End With

Next i

End Sub

ИЛИ используйте этот код на основе именованного диапазона "MakeMeAChart" (измените как хотите) для всех данных, но не для заголовков. Он создаст диаграмму с каждой строкой ряда, а затем пометит их все первым столбцом:

Sub BubbleLabel_Click()

Dim i As Integer

With ActiveSheet.ChartObjects.Add(Left:=100, Width:=375, Top:=75, Height:=225)
  For i = 1 To Range("MakeMeAChart").Rows.Count
    .Chart.SeriesCollection.NewSeries
    .Chart.SeriesCollection(i).Name = Range("MakeMeAChart").Rows(i).Cells(1, 1)
    .Chart.SeriesCollection(i).XValues = Range("MakeMeAChart").Rows(i).Cells(1, 3)
    .Chart.SeriesCollection(i).Values = Range("MakeMeAChart").Rows(i).Cells(1, 4)
    If i = 1 Then .Chart.ChartType = xlBubble3DEffect
    .Chart.SeriesCollection(i).BubbleSizes = "="& Range("MakeMeAChart").Parent.Name _
                & "!" & Range("MakeMeAChart").Cells(1, 2).Address(1, 1, xlR1C1)
  Next i

  For i = 1 To .Chart.SeriesCollection.Count
    With .Chart.SeriesCollection(i)
      .ApplyDataLabels
      .DataLabels.ShowSeriesName = True
      .DataLabels.ShowValue = False
    End With
  Next i
  .Chart.Legend.Delete
End With

End Sub

Примечание. В пузырьковых диаграммах в VBA есть много ошибок и хитростей.