VBA根据包含一些文本的标题更新图表

Question

我有一张图表可以帮助我按人物绘制一系列事件。我绘图时需要一些事件类才能保持一致性。

例如，简在她的职业生涯中被雇用了两次。我希望那种雇佣方式是一样的。但是，Excel会将这些作为不同的类中断，因为一个名为01-Hire而另一个名为02-Hire。在下面的例子中，所有雇员都应该是蓝色的。

我想要一些代码来搜索＆＃34; Hire＆＃34;在标题中然后应用一致的颜色。 注意，序列之间可能有不同的标题，因此代码必须足够智能，才能对包含相同文本（而不是序列号）的内容进行分组。

我能找到的最接近的事情是： Set Color codes to the legends in vba

Private Sub FormatShapeLegend(sheet As Worksheet, legendName As String, targetColor As MsoRGBType)
    Dim shp As Shape
    Dim chrt As Chart
    Dim s As Series

    For Each shp In sheet.Shapes
        If shp.HasChart Then
            Set chrt = shp.Chart

            'Loop the dataseries to find the legend with the desired name.
            For Each s In chrt.SeriesCollection
                'If the name fits, go ahead and format the series.
                If LCase(s.Name) = LCase(legendName) Then
                    s.Format.Fill.ForeColor.RGB = targetColor
                End If
            Next
        End If
    Next
End Sub

FormatShapeLegend ActiveSheet, "ISO", RGB(0, 0, 255)

我想对类似于图表的所有类别执行此操作。

期望的输出

数据表

原始代码     行标签01 - 雇用01 - 促销01 - 期限02 - 雇用02 - 促销02 - 期限03 - 雇用03 - 促销03 - 期限     简38 10 29
    本15 50 10     乔68 56 10 7
    Lisa 61 41
    珍妮24
    杰里81 16

Answer 1

如果您的系列标签总是重复“Hire x”，“Prom x”，“Term x”，那么这样的话会起作用：

Dim s As Series, x As Long
x = 0

For Each s In ActiveSheet.ChartObjects(1).Chart.SeriesCollection
    x = x + 1
    s.Format.Fill.ForeColor.RGB = Array(vbBlue, vbRed, vbGreen)(x Mod 3)
Next s

如果您需要根据系列名称进行操作，那么：

Dim s As Series, clr As Long, nm As String

For Each s In ActiveSheet.ChartObjects(1).Chart.SeriesCollection

    nm = LCase(s.Name)

    clr = vbYellow 'default
    If nm Like "*hire*" Then
        clr = vbBlue
    ElseIf nm Like "*prom*" Then
        clr = vbGreen
    ElseIf nm Like "*term*" Then
        clr = vbRed
    End If

    s.Format.Fill.ForeColor.RGB = clr

Next s