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

Question

这是此问题的后续问题：

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

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

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

只要您的类别位于第 1 行且您的值位于第 2 行，该例程就可以正常工作。

如何使其适用于任意范围的两行，例如第 5/6 行或 27/28 行？

Cells(categoryColorRow, colIndex)

和

Cells(valueColorRow, colIndex)

始终指向第 1 行和第 2 行。

如何从图表系列公式推导出

colIndex

？

Sub Labels_SourceROWS_v2()
   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
           .Separator = vbLf
           .Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
           .Format.TextFrame2.TextRange.Font.Bold = False
           .NumberFormat = "0,0000"
           .Position = xlLabelPositionOutsideEnd
           .Font.Name = "Calibri"
           .Font.Size = 10
       End With
       For Each p In .Points
           labelItems = Split(p.DataLabel.Text, vbLf)
           labelItems(1) = Format(Replace(labelItems(1), ".", ","), "0.00")
           With p.DataLabel.Format.TextFrame2.TextRange
               'Load Label with Category and Value
               .Text = labelItems(0) & vbLf & labelItems(1)
               startPos = 1
               'Category
               length = Len(labelItems(0))
               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
           End With
           colIndex = colIndex + 1
       Next
   End With
End Sub

Answer 1

正如我在上面的评论中所说，您需要从公式中提取系列范围行。请测试上面的改编代码：

Sub Labels_SourceROWS_v2()
   Dim p As point, CatValueLength As Variant, dls As DataLabels, length As Long
   Dim labelItems As Variant, categoryColorRow As Long
   Dim valueColorRow As Long, colIndex As Long, color As Long
   Dim valueText As String, percentText As String, startPos As Long
   
   categoryColorRow = 1
   With ActiveChart.SeriesCollection(1)
       .HasDataLabels = True

       'new code lines exgtracting the necesssary variables value:__
       valueColorRow = Range(Split(.Formula, ",")(2)).row
       categoryColorRow = Range(Split(.Formula, ",")(1)).row
       colIndex = Range(Split(.Formula, ",")(1)).column
       '____________________________________________________________

       With .DataLabels
           .ShowValue = True
           .ShowCategoryName = True
           .Separator = vbLf
           .Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
           .Format.TextFrame2.TextRange.Font.Bold = False
           .NumberFormat = "0,0000"
           .Position = xlLabelPositionOutsideEnd
           .Font.name = "Calibri"
           .Font.size = 10
        End With
       
       For Each p In .points
           labelItems = Split(p.DataLabel.Text, vbLf)
           labelItems(1) = Format(VBA.Replace(labelItems(1), ".", ","), "0.00")
           With p.DataLabel.Format.TextFrame2.TextRange
               'Load Label with Category and Value:
               .Text = labelItems(0) & vbLf & labelItems(1)
               startPos = 1
               'Category:
               length = Len(labelItems(0))
               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
           End With
           colIndex = colIndex + 1
       Next
   End With
End Sub

请在测试后发送一些反馈