Excel 图表：按类别为数据标签着色 - 列

Question

以下代码根据两行排列的类别和值对图表数据标签进行着色。

• 第 1 行 = 类别
• 第 2 行 = 值

如何使代码适用于排列在两列中的数据？

• A 列 = 类别
• B 列 = 值

更换

Dim categoryColorRow As Long
Dim valueColorRow As Long
categoryColorRow = 1 
valueColorRow = 2
colIndex = 2 

与

Dim categoryColorCol As Long
Dim valueColorCol As Long
categoryColorCol = 1 
valueColorCol = 2 
colIndex = 2 

不起作用。它不会改变代码的行为。它只会使用行进行操作，不会将列作为源。

这就是整个例程，它非常适合行：

Sub Labels_SourceROWS()
  Dim p As Point
  Dim CatValueLength As Variant
  Dim dls As DataLabels
  Dim length As Long
  Dim labelItems As Variant
  Dim categoryColorRow As Long
  Dim valueColorRow As Long
  Dim colIndex As Long
  Dim color As Long
  Dim valueText As String
  Dim percentText As String
  Dim startPos As Long
  categoryColorRow = 1 
  valueColorRow = 2 
  colIndex = 2 
  With ActiveChart.SeriesCollection(1)
      .HasDataLabels = True
      With .DataLabels
          .ShowValue = True
          .ShowCategoryName = True
          .ShowPercentage = True
          .Separator = vbLf
          .Format.TextFrame2.TextRange.Font.Bold = False
          .NumberFormat = "#.##0,00;- #.##0,00"
          .Position = xlLabelPositionBestFit
          .Font.Name = "Arial Narrow"
          .Font.Size = 8
      End With
      For Each p In .Points
          labelItems = Split(p.DataLabel.Text, vbLf)
          labelItems(1) = Format(Replace(labelItems(1), ".", ","), "0.00")
          labelItems(2) = Format(Replace(labelItems(2), ".", ","), "0.00%")
          With p.DataLabel.Format.TextFrame2.TextRange
              'load datalabel
              .Text = labelItems(0) & vbLf & labelItems(1) & vbLf & labelItems(2)
              startPos = 1
              length = Len(labelItems(0)) 'Category
              color = ActiveSheet.Cells(categoryColorRow, colIndex).Font.color
              .Characters(startPos, length).Font.Bold = True
              .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
              'Value
              color = ActiveSheet.Cells(valueColorRow, colIndex).Font.color
              startPos = startPos + length + 1
              length = Len(labelItems(1))
              .Characters(startPos, length).Font.Bold = True
              .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
              'Percentage
              color = ActiveSheet.Cells(valueColorRow, colIndex).Font.color
              startPos = startPos + length + 1
              length = Len(labelItems(2))
              .Characters(startPos, length).Font.Bold = False
              .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
          End With
          colIndex = colIndex + 1
      Next
  End With
End Sub

Answer 1

• Cells(valueColorRow, colIndex)

  和

  Cells(valueColorRow, colIndex)

  指向错误的单元格。

• colIndex

  源自图表系列公式。

Sub Labels_SourceCOLUMNS()
   Dim p As Point
   Dim CatValueLength As Variant
   Dim dls As DataLabels
   Dim length As Long
   Dim labelItems As Variant
   Dim categoryColorRow As Long
   Dim valueColorCol As Long
   Dim colIndex As Long
   Dim color As Long
   Dim valueText As String
   Dim percentText As String
   Dim startPos As Long
   categoryColorRow = 1
   valueColorCol = 2
   ' colIndex = 2
'   ActiveSheet.ChartObjects(1).Activate
'    Dim s As Series
'    Set s = ActiveChart.SeriesCollection(1)
'    Stop
   With ActiveChart.SeriesCollection(1)
       colIndex = Range(Split(.Formula, ",")(1)).Column
       categoryColorRow = Range(Split(.Formula, ",")(1)).Row ' **
       .HasDataLabels = True
       With .DataLabels
           .ShowValue = True
           .ShowCategoryName = True
           .ShowPercentage = True
           .Separator = vbLf
           .Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
           .Format.TextFrame2.TextRange.Font.Bold = False
           .NumberFormat = "0,0000"
           .Position = xlLabelPositionOutsideEnd
           .Font.Name = "Arial Narrow"
           .Font.Size = 10
       End With
       For Each p In .Points
            startPos = 1
           labelItems = Split(p.DataLabel.Text, vbLf)
           'labelItems(1) = Format(Replace(labelItems(1), ".", ","), "0.00") 'no need
           labelItems(2) = Format(Replace(labelItems(2), ".", ","), "0.00%")
           With p.DataLabel.Format.TextFrame2.TextRange
               ' load datalabel with text
               .Text = labelItems(0) & vbLf & labelItems(1) & vbLf & labelItems(2)
               length = Len(labelItems(0)) 'Category
               color = ActiveSheet.Cells(categoryColorRow, colIndex).Font.color
               .Characters(startPos, length).Font.Bold = True
               .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
               'Value
               color = ActiveSheet.Cells(categoryColorRow, colIndex + 1).Font.color
               startPos = startPos + length + 1
               length = Len(labelItems(1))
               .Characters(startPos, length).Font.Bold = True
               .Characters(startPos, length).Font.Fill.ForeColor.RGB = color

               color = vbBlack
               startPos = startPos + length + 1
               length = Len(labelItems(2))
               .Characters(startPos, length).Font.Bold = False
               .Characters(startPos, length).Font.Fill.ForeColor.RGB = color
           End With
           categoryColorRow = categoryColorRow + 1
       Next
   End With
End Sub