Question

我有以下动态表格，

最后一列是一个验证列，它将标记我感兴趣的MP的行，

此表格将在另一张表格中提供图表。我想做的是：

标识添加标识符的行（例如本例中的DT），，并将其用作图表中颜色的序列号，在另一张表中。< /强>

我想做的是

Dim DTrow As Long Dim ORrow As Long Dim EErow As Long Dim OTrow As Long Set myRange = Worksheets("Financials").Range("M98:M103") With Worksheets("NatCo Dashboard").ChartObjects("Chart 9") DTrow = Application.WorksheetFunction.Match("DT", myRange, 0) ORrow = Application.WorksheetFunction.Match("MP2", myRange, 0) EErow = Application.WorksheetFunction.Match("MP3", myRange, 0) OTrow = Application.WorksheetFunction.Match("MP4", myRange, 0) Select Case Sheets("Financials").Range(myRange) Case Is = "DT" Worksheets("NatCo Dashboard").ChartObjects("Chart 9").Chart.SeriesCollection(DTrow).Format.Fill.ForeColor.RGB = RGB(226, 0, 116) Case Is = "Orange" Worksheets("NatCo Dashboard").ChartObjects("Chart 9").Chart.SeriesCollection(ORrow).Format.Fill.ForeColor.RGB = RGB(255, 153, 0) Case Is = "EE" Worksheets("NatCo Dashboard").ChartObjects("Chart 9").Chart.SeriesCollection(EErow).Format.Fill.ForeColor.RGB = RGB(52, 161, 160) Case Is = "Other" Worksheets("NatCo Dashboard").ChartObjects("Chart 9").Chart.SeriesCollection(OTrow).Format.Fill.ForeColor.RGB = RGB(0, 0, 0) End Select End With

我不能让它像这样工作，任何人都知道我可能做错了什么？

谢谢！

Answer 1

您的Select Case被堵塞了：它会检查myRange顶部的单元格（并且，由于myRange已包含工作簿/ Worsheet详细信息，因此您不需要＆＃ 39; t需要使用Sheets("Financials").Range(myRange)，只需myRange）

至少，您需要For Each <Range Variable> In myRange.Cells分别检查每一行。但是，如果您要那，那么您就不需要Match位......

所以，让我们简化：您可以使用该名称来获取该集合。（假设您已为您的系列指定了正确/动态名称）

观察：DTName = Worksheets("Financials").Cells(6, WorksheetFunction.Match("DT",myRange,0)).Value将从列F（6 ^th列）中提供值，除非"DT"中不存在myRange。（但是，这是On Error的用途）

Private Sub MuchShorter()
    Dim SearchFor() As Variant, SeriesName As String, SeriesColours() As Variant, lTMP As Long
    SearchFor = Array("DT", "MP2", "MP3", "MP4")
    SeriesColours = Array(RGB(226, 0, 116), RGB(255, 153, 0), RGB(52, 161, 160), RGB(0, 0, 0))

    On Error Resume Next 'Skip any series that don't exist
    For lTMP = lBound(SearchFor) To uBound(SearchFor) 'Auto-size
        SeriesName = ""
        SeriesName = Worksheets("Financials").Cells(6, WorksheetFunction.Match(SearchFor(lTMP), myRange, 0)).Value 'Look in Column M for the code, then get name from Column F
        If Len(SeriesName) > 0 Then
            ThisWorkbook.Worksheets("NatCo Dashboard").ChartObject("Chart 9").Chart.SeriesCollection(SeriesName).Format.Fill.ForeColor.RGB = SeriesColours(lTMP)
        End If
    Next lTMP
    On Error GoTo 0
End Sub

如果您需要更多标签，只需将它们添加到SearchFor数组，然后将颜色添加到SeriesColours数组

Answer 2

如果应该匹配一个，并且您正在尝试更改线条的颜色（并且线条的绘制顺序与范围相同）。如果需要，您可以恢复为Option Explicit Sub test() Dim DTrow As Variant Dim ORrow As Variant Dim EErow As Variant Dim OTrow As Variant Dim myRange As Range Set myRange = Worksheets("Financials").Range("M98:M103") DTrow = Application.Match("DT", myRange, 0) ORrow = Application.Match("MP2", myRange, 0) EErow = Application.Match("MP3", myRange, 0) OTrow = Application.Match("MP4", myRange, 0) With Worksheets("NatCo Dashboard").ChartObjects("Chart 9").Chart Select Case True Case Not IsError(DTrow) .SeriesCollection(DTrow).Format.Line.ForeColor.RGB = RGB(226, 0, 116) Case Not IsError(ORrow) .SeriesCollection(ORrow).Format.Line.ForeColor.RGB = RGB(255, 153, 0) Case Not IsError(EErow) .SeriesCollection(EErow).Format.Line.ForeColor.RGB = RGB(52, 161, 160) Case Not IsError(OTrow) .SeriesCollection(OTrow).Format.Line.ForeColor.RGB = RGB(0, 0, 0) End Select End With End Sub。

Sub test2()

    Dim DTrow As Variant
    Dim ORrow As Variant
    Dim EErow As Variant
    Dim OTrow As Variant
    Dim myRange As Range

    Set myRange = Worksheets("Financials").Range("M98:M103")

    DTrow = Application.Match("DT", myRange, 0)
    ORrow = Application.Match("MP2", myRange, 0)
    EErow = Application.Match("MP3", myRange, 0)
    OTrow = Application.Match("MP4", myRange, 0)

    With Worksheets("NatCo Dashboard").ChartObjects("Chart 9").Chart

    On Error Resume Next
        .SeriesCollection(DTrow).Format.Line.ForeColor.RGB = RGB(226, 0, 116)
        .SeriesCollection(ORrow).Format.Line.ForeColor.RGB = RGB(255, 153, 0)
        .SeriesCollection(EErow).Format.Line.ForeColor.RGB = RGB(52, 161, 160)
        .SeriesCollection(OTrow).Format.Line.ForeColor.RGB = RGB(0, 0, 0)
    On Error GoTo 0

    End With

End Sub

如果您试图为所有匹配的行着色（这似乎更有可能）：

Else

编辑：

如果您想为其他与某些默认值不匹配的颜色设置颜色，请执行以下操作。

注意：

你可以整理一下
我已对.SeriesCollection(1)的系列进行了硬编码，例如RGB(1, 1, 1)
您可以使用每行的默认值替换.SeriesCollection(1)
如果你知道索引，那么，例如，.SeriesCollection（DTrow）可以只是Sub test3() Dim DTrow As Variant Dim ORrow As Variant Dim EErow As Variant Dim OTrow As Variant Dim myRange As Range Set myRange = Worksheets("Financials").Range("M98:M103") DTrow = Application.Match("DT", myRange, 0) ORrow = Application.Match("MP2", myRange, 0) EErow = Application.Match("MP3", myRange, 0) OTrow = Application.Match("MP4", myRange, 0) With Worksheets("NatCo Dashboard").ChartObjects("Chart 9").Chart If Not IsError(DTrow) Then .SeriesCollection(DTrow).Format.Line.ForeColor.RGB = RGB(226, 0, 116) Else .SeriesCollection(1).Format.Line.ForeColor.RGB = RGB(1, 1, 1) End If If Not IsError(ORrow) Then .SeriesCollection(ORrow).Format.Line.ForeColor.RGB = RGB(255, 153, 0) Else .SeriesCollection(2).Format.Line.ForeColor.RGB = RGB(1, 1, 1) End If If Not IsError(EErow) Then .SeriesCollection(EErow).Format.Line.ForeColor.RGB = RGB(52, 161, 160) Else .SeriesCollection(3).Format.Line.ForeColor.RGB = RGB(1, 1, 1) End If If Not IsError(OTrow) Then .SeriesCollection(OTrow).Format.Line.ForeColor.RGB = RGB(0, 0, 0) Else .SeriesCollection(4).Format.Line.ForeColor.RGB = RGB(1, 1, 1) End If End With End Sub
```
{{1}}
```

在VBA中使用匹配函数来着色图表系列

2 个答案: