Question

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

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

Answer 1

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

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全局属性的最佳方式。我已将ActiveWorkbook更改为Target.Parent.Parent，将ActiveSheet更改为Target.Parent。

Answer 2

谢谢@omegastripes，.item是不允许的，如果这样添加了一个var 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

VBA编码重复条件的最佳方式

2 个答案: