☰

Excel：气泡图标签 - 使用第四维？

tag-icon • tag-icon microsoft-excel charts
Excel：气泡图标签 - 使用第四维？

我有一个具有 4 个维度的数据集 - 假设它们如下：

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

我想要做的是在 Excel 中绘制这些数据的气泡图。我可以愉快地绘制一个显示价格与质量的图表，然后我可以根据金额调整气泡的大小。但是，我似乎找不到使用类型维度标记气泡的方法。默认标签似乎只是图表上使用的现有三个维度之一，这对我来说没什么用。

我知道我可以添加数据标签，然后手动重命名每个标签，但是有没有办法自动使用第四维作为标签？

答案1

一旦您设置了图表并将每个气泡设置为由类型列命名的系列（这本身就很麻烦），只需运行此代码，它就会根据该系列名称标记所有气泡：

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 中制作气泡图有很多错误和技巧。

答案2

.Rows(i)@Lance 的代码运行良好。我只是在设置 ChartType 时遇到了问题，在设置 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

相关内容