如何重叠在VBA中所做的更改

时间:2018-10-15 16:29:36

标签: excel 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时,突出显示的单元格发生更改,我不希望这种情况发生。我希望由于从B39中选择SKU而导致的更改即使在更改了B57之后也能保留。

希望这种澄清效果更好。

谢谢!

1 个答案:

答案 0 :(得分:0)

问题似乎是您希望进行高亮/清除的范围重叠:当产品的材料重叠时,您无法像尝试那样管理突出显示。您需要做的是清除 all 突出显示,然后检查每个“目标”单元格以查看需要重新添加哪些亮点:不要只检查已更改的一个目标单元格。

我将阴影转移到一个单独的子目录中,并删除了所有“选择”步骤-通常最好避免这些步骤。

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