Question

想要创建一些动态仪表板，其中形状将改变颜色，因为参考单元格的值会发生变化（基于某个阈值）。

代码：

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("M5")) Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) Then
        If Target.Value < Range("$AA$5") Then
            ActiveSheet.Shapes("Isosceles Triangle 3").Fill.ForeColor.RGB = vbRed
        ElseIf Target.Value >= Range("$AA$5") And Target.Value < Range("$Y$5") Then
            ActiveSheet.Shapes("Isosceles Triangle 3").Fill.ForeColor.RGB = vbYellow
        ElseIf Target.Value >= Range("$Y$5") And Target.Value < Range("$Z$5") Then
            ActiveSheet.Shapes("Isosceles Triangle 3").Fill.ForeColor.RGB = vbGreen
        ElseIf Target.Value >= Range("$Z$5") And Target.Value < Range("$AB$5") Then
            ActiveSheet.Shapes("Isosceles Triangle 3").Fill.ForeColor.RGB = vbYellow
        Else
            ActiveSheet.Shapes("Isosceles Triangle 3").Fill.ForeColor.RGB = vbRed
        End If
    End If   

End Sub

这适用于仪表板中的一个三角形，具有一些定义的阈值（动态更改颜色）。想要与其他三角形复制相同的操作。怎么做？

[！[三角形序列] [1]] [1]

已编辑＆amp;添加部分：

仪表板具有多个品牌明智的性能来展示。

示意图：[在此处输入图像说明] [2]

CFA，DB＆amp;品牌旗下各品牌的实际数据SS级别：实际数据 [在此处输入图像说明] [3]

CFA，SS＆amp;子D： [在此处输入图像说明] [4]

因此，对于每个品牌（品牌1,2和3）的库存点（CFA，DB＆amp; SS级别），颜色代码的行为如下：

If the actual< UCL2, the triangle will be red (e.g. Brand1 at CFA is 9, respective tringle will be red), UCL2<= actual Yellow , UCL1<= actual Green , LCL1<= actual Yellow , Actual =>LCL2 --> Red

希望现在问题更加明显。预计对此有所帮助... TIA

Answer 1

根据您的要求编辑

并且重新进行了重构

Private Sub Worksheet_Change(ByVal Target As Range)

     Colorize ActiveSheet.Shapes("Isosceles Triangle 1"), Target, Range, ("M1"), Range("$AA$5").Value, Range("$AB$5").Value, Range("$Y$5").Value, Range("$Z$5").Value
     Colorize ActiveSheet.Shapes("Isosceles Triangle 2"), Target, Range("M3"), 19, 60, 32, 38
     'Colorize ActiveSheet.Shapes("Isosceles Triangle 3"), Target, Range("M5")

End Sub

Private Sub Colorize(shp As Shape, ByVal Target As Range, rValue as Range, _
     YellowLow As long, YellowHigh As Long, _
     GreenLow As Long, GreenHigh As Long)

     Dim iColor As Long

     If Intersect(Target, rValue) Is Nothing Then Exit Sub

     'If IsNumeric(Target.Value) Then
     '    iColor = vbRed
     '    If Target.Value < Range("$AA$5") Then
     '        iColor = vbRed
     '    ElseIf Target.Value >= Range("$AA$5") And Target.Value < Range("$Y$5") Then
     '        iColor = vbYellow
     '    ElseIf Target.Value >= Range("$Y$5") And Target.Value < Range("$Z$5") Then
     '        iColor = vbGreen
     '    ElseIf Target.Value >= Range("$Z$5") And Target.Value < Range("$AB$5") Then
     '        iColor = vbYellow
     '    End If
     If IsNumeric(Target.Value) Then
         iColor = vbRed
         If Target.Value >= YellowLow And Target.Value <= YellowHigh Then  iColor = vbYellow
         If Target.Value >= GreenLow And Target.Value <= GreenHigh Then    iColor = vbGreen
         shp.Fill.ForeColor.RGB = iColor
    End If  
End Sub

具有相同宏的多个worksheet_change，具有不同的引用单元格

1 个答案: