Question

我试图在列中修改一个单元格，该单元格是从＆＃34; a＆＃34;到＆＃34; b＆＃34; （应该通过宏排除从空白到＃34; a＆＃34;）的更改。任何人都可以帮助我吗？

＆＃13;

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
ActiveCell.Select
Application.Run ("color")
End If
End Sub

Sub color()
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .color = 255
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
End Sub

＆＃13;

以上代码也会突出显示已编辑单元格下方的单元格。

Answer 1

您可以使用SelectionChange事件在更改之前获取值，然后添加您的条件。

请注意，如果在目标范围内选择了一个单元格打开工作簿，并且您在不更改选择的情况下更改了该值，则此代码将提前退出，因为ValBeforeChange的值尚未设置。

你可以用两种方式来处理。您可以向Workbook_Open事件添加内容以运行SelectionChange例程或，您可以将ValBeforeChange设为全局变量，并将其最初设置为{{1事件，或者您可以将突出显示代码重构为具有“之前”和“之后”属性的类，在打开时实例化一个类对象并在关闭时清理它。

以下是添加条件检查的方法：

从“a”修改为“b”（应排除从空白到的更改） “A”）

Workbook_Open

Answer 2

实际上，我不想添加新答案。因为这个答案只是CBRF23答案的一个小修改。根据他们的评论，我决定添加新的答案，因为我认为这个问题得不到正确答案。

我的回答有什么新内容。没什么特别的。但我格式化了代码并且我添加了空白值检查并删除了突出显示。

在这里，您可以看到代码不同。

Dim ValBeforeChange As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    ValBeforeChange = Target.Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False

    If Not Len(ValBeforeChange) > 0 Then
        Exit Sub
    End If

    If Target.Value = ValBeforeChange Then
        Exit Sub
    End If

    If Application.Intersect(Range("A:A"), Target) Is Nothing Then
        Exit Sub
    End If

    If Target.Value <> "" Then
        Highlight Target, vbRed
    Else
        Highlight Target, xlNone
    End If

End Sub

Sub Highlight(ByRef Target As Range, ByVal colorValue As Variant)

    With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .color = colorValue
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

End Sub

Answer 3

Dim ValBeforeChange As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    ValBeforeChange = Target.Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False

    

    If ValBeforeChange ="" Then
        Exit Sub
    End If
    IF ValBeforeChange <> Target.Value Then
    
    If Application.Intersect(Range("A:A"), Target) Is Nothing Then
    Application.Run("Color")    
    End If
  
    End If
    

End Sub

这段代码很有效，谢谢大家的帮助：）

突出显示修饰细胞

3 个答案: