Excel VBA编写重复条件代码的最佳方法

我有六个位置a，b，c，d，e，f在我的轴切片机，我有五个盒子形状的基础上是灰色的。根据切片器中的选择，框颜色将变为绿色。选择所有位置后，所有框将变为绿色。 我通过VBA中的if条件实现了这一点。但我对如何满足用户只选择三个或两个位置的条件感到困惑。编码以满足此条件的最佳方式是什么

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    If Target.Name = "PivotTable4" Then
        If ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("a").Selected = True Then
            With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor
                .RGB = vbGreen
            End With
            With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
        ElseIf ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("b").Selected = True Then
            With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor
                .RGB = vbGreen
            End With
            With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
        ElseIf ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("c").Selected = True Then
            With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor
                .RGB = vbGreen
            End With
            With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
        ElseIf ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("d").Selected = True Then
            With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor
                .RGB = vbGreen
            End With
            With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
        ElseIf ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("e").Selected = True Then
            With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor
                .RGB = vbGreen
            End With
            With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
        ElseIf ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("f").Selected = True Then
            With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor
                .RGB = vbGreen
            End With
            With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
            With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor
                .RGB = RGB(205, 192, 176)
            End With
        End If
    End If
End Sub

---

可以使用字典存储形状名称和相应的切片器名称，并根据切片器的选定状态设置形状颜色：

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim sShape
    If Target.Name = "PivotTable4" Then
        ' instantiate dictionary
        With CreateObject("Scripting.Dictionary")
            ' fill the dict with shape names as keys and corresponding slicer names as values
            .Item("Freeform: Shape 6") = "a"
            .Item("Freeform: Shape 15") = "b"
            .Item("Freeform: Shape 11") = "c"
            .Item("Freeform: Shape 12") = "d"
            .Item("Freeform: Shape 7") = "e"
            .Item("Freeform: Shape 9") = "f"
            ' set forecolor for each shape depending on corresponding slicer actual selected state
            For Each sShape In .Keys
                Target.Parent.Shapes(sShape).Fill.ForeColor.RGB = IIf( _
                    Target.Parent.Parent.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems(.Item(sShape)).Selected, _
                    vbGreen, _
                    RGB(205, 192, 176) _
                )
            Next
        End With
    End If
End Sub

甚至可以使用嵌套数组：

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim aShape
    If Target.Name = "PivotTable4" Then
        ' loop through shapes using array populated by nested arrays with shape/slicer name pairs
        For Each aShape In Array( _
            Array("Freeform: Shape 6", "a"), _
            Array("Freeform: Shape 15", "b"), _
            Array("Freeform: Shape 11", "c"), _
            Array("Freeform: Shape 12", "d"), _
            Array("Freeform: Shape 7", "e"), _
            Array("Freeform: Shape 9", "f") _
        )
            ' set forecolor for the shape depending on the slicer actual selected state
            Target.Parent.Shapes(aShape(0)).Fill.ForeColor.RGB = IIf( _
                Target.Parent.Parent.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems(aShape(1)).Selected, _
                vbGreen, _
                RGB(205, 192, 176) _
            )
        Next
    End If
End Sub

没有测试，因为我没有这样的数据结构，如果我正确理解您的意图，那么应该可以工作

---

请注意，依赖

ActiveWorkbook

和

ActiveSheet

全局属性并不是最好的方法。我已经用

Target.Parent.Parent

更改了

ActiveWorkbook

，用

Target.Parent

更改了

ActiveSheet

，谢谢@omegastripes.。如果这样添加了变量d并且有效，则不允许在中使用项

  Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim sShape
    Dim d
    If Target.Name = "PivotTable4" Then
        ' instantiate dictionary
        Set d = CreateObject("Scripting.Dictionary")
        With d
            ' fill the dict with shape names as keys and corresponding slicer names as values
            .Item("Freeform: Shape 6") = "a"
            .Item("Freeform: Shape 15") = "b"
            .Item("Freeform: Shape 11") = "c"
            .Item("Freeform: Shape 12") = "d"
            .Item("Freeform: Shape 7") = "e"
            .Item("Freeform: Shape 9") = "f"
            ' replace each slicer name with it's actual selected state
            For Each sShape In .Keys
                d.Item(sShape) = ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems(.Item(sShape)).Selected
            Next
            ' set forecolor for each shape individually
            For Each sShape In .Keys
                With ActiveSheet.Shapes(sShape).Fill.ForeColor
                    If d.Item(sShape) Then
                        .RGB = vbGreen
                    Else
                        .RGB = RGB(205, 192, 176)
                    End If
                End With
            Next
        End With
    End If
End Sub

---

从发布你的代码开始，请阅读以下内容：你说的是5个位置和5个形状，但代码中有6个-请澄清。我得到一个错误对象不支持这一行中的属性“If.Item（sShape）”，然后“@Danny我明白了，这是我的错，我没有测试代码，看看字典的固定版本和嵌套数组的替代版本。每个块的

之前的所有
d.Item
都应该替换为
.Item
，否则根本没有理由将
与d
一起使用，因为您没有利用它