首页 > 解决方案 > 如何重叠在 VBA 中所做的更改

问题描述

下面是我想要澄清的代码:

'Auto format the cells when you change cell B39

If Not Intersect(Target, Range("B39")) Is Nothing Then

    If InStr(1, Range("B39"), "ABC") > 0 Then
        Range("B13:B18,B22,B23,B25").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = RGB(100, 250, 150)
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Range("B19:B21,B24,B26:B35").Select
        With Selection.Interior
                .Pattern = xlNone
                .PatternTintAndShade = 0
        End With
    Else: Range("B13:B35").Select
        With Selection.Interior
                .Pattern = xlNone
                .PatternTintAndShade = 0
        End With
    End If
End If

If Not Intersect(Target, Range("B57")) Is Nothing Then

    If Range("B57") = "DEF" Then
        Range("B13:B18,B22,B23,B25,B30,B35").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = RGB(100, 250, 150)
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Range("B19:B21,B24,B26,B27:B29,B31:B34").Select
        With Selection.Interior
                .Pattern = xlNone
                .PatternTintAndShade = 0
        End With
    End If
End If
End Sub

在 B39 和 B57 单元格中,我有该公司生产的产品的下拉列表。上面的代码强调了制造这些产品的要求。当我从 B39 中选择 SKU 时,代码会突出显示指定的范围。B57 也一样。当我先更改 B39 然后更改 B57 时,突出显示的单元格会发生变化,我不希望这种情况发生。我希望即使在更改 B57 之后,由于从 B39 中选择 SKU 而导致的更改仍然存在。

希望这个澄清更好。

谢谢!

标签: excelvba

解决方案


似乎问题在于您想要隐藏/清除的重叠范围:当您拥有具有重叠材料的产品时,您无法像尝试那样管理突出显示。您需要做的是清除所有突出显示,然后检查每个“目标”单元格以查看需要重新添加哪些突出显示:不要只检查一个已更改的目标单元格。

我将 hiliting 移到一个单独的 sub 中并删除了任何 Select 步骤 - 通常最好避免这些步骤。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("B39,B57")) Is Nothing Then

        Hilite Range("B13:B100"), False '<< clear *all* hiliting

        'add back any required hilites
        If InStr(1, Range("B39"), "ABC") > 0 Then
            Hilite Range("B13:B18,B22,B23,B25"), True
        End If
        If Range("B57") = "DEF" Then
            Hilite Range("B13:B18,B22,B23,B25,B30,B35"), True
        End If

    End If
End Sub

'add/remove hilighting on a supplied range
Sub Hilite(rng As Range, hilight As Boolean)
    With rng.Interior
        If hilight Then
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = RGB(100, 250, 150)
            .TintAndShade = 0
            .PatternTintAndShade = 0
        Else
            .Pattern = xlNone
            .PatternTintAndShade = 0
        End If
    End With
End Sub

推荐阅读