Question

我想使用vba执行conditional formatting。

我想用字符串Yes的绿色和红色格式化包含字符串No的单元格背景。之前，我使用了For loop，但是由于数据量巨大，该算法需要大量时间，因此excel无法响应。

然后我尝试使用Private Sub Worksheet_Change(ByVal Target As Range)来检测单元格中的变化并为其应用颜色，但是它不能像预期的那样起作用。

这是我到目前为止尝试过的：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRange As Range
Dim KeyCells As Range

Set KeyCells = Range("A1:A10")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then

Set MyRange = ActiveCell   
    MyRange.Select

    If MyRange.Value = "Yes" Then
    MyRange.Interior.ColorIndex = 35
    MyRange.Font.ColorIndex = 50

    ElseIf MyRange.Value = "No" Then
    MyRange.Interior.ColorIndex = 22
    MyRange.Font.ColorIndex = 9

    Else
    MyRange.Value = ""
    MyRange.Interior.ColorIndex = xlNone
    MyRange.Font.ColorIndex = 1

    End If

End If
End Sub

Answer 1

为支持我的评论，这是解决方法

Private Sub Worksheet_Change(ByVal target As Range)

Dim KeyCells As Range

Set KeyCells = Range("A1:A10")

If Not Application.Intersect(KeyCells, Range(target.Address)) _
       Is Nothing Then

    If target.Value = "Yes" Then
    target.Interior.ColorIndex = 35
    target.Font.ColorIndex = 50

    ElseIf target.Value = "No" Then
    target.Interior.ColorIndex = 22
    target.Font.ColorIndex = 9

    Else
    target.Value = ""
    target.Interior.ColorIndex = xlNone
    target.Font.ColorIndex = 1

    End If

End If
End Sub

Answer 2

您需要注意，一次可以更改多个单元格。例如。如果用户将值粘贴到范围内-或选择一个范围然后删除。

要解决此问题，请循环浏览更改区域中的每个单元格。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyRange As Range
    Dim KeyCells As Range

    Set KeyCells = Range("A1:A10")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

        Application.EnableEvents = False
        For Each MyRange In Application.Intersect(KeyCells, Range(Target.Address)).Cells

            If MyRange.Value = "Yes" Then
            MyRange.Interior.ColorIndex = 35
            MyRange.Font.ColorIndex = 50

            ElseIf MyRange.Value = "No" Then
            MyRange.Interior.ColorIndex = 22
            MyRange.Font.ColorIndex = 9

            Else
            MyRange.Value = ""
            MyRange.Interior.ColorIndex = xlNone
            MyRange.Font.ColorIndex = 1

            End If
        Next
        Application.EnableEvents = True
    End If

End Sub

测试：

Answer 3

  Private Sub Worksheet_Change(ByVal Target As Range)
  Dim MyRange As Range
  Dim KeyCells As Range

  Set KeyCells = Range("A1:A10")

  If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then
  With Target
       If .Value = "Yes" Then
        .Interior.ColorIndex = 35
        .Font.ColorIndex = 50
       ElseIf .Value = "No" Then
        .Interior.ColorIndex = 22
        .Font.ColorIndex = 9
       ElseIf .Value = "" Then
        .Interior.ColorIndex = xlNone
        .Font.ColorIndex = 1       
       End If
 End With
 End If
 End Sub

Answer 4

如果要检查的单元格始终为A1：A10或其他永远不变的范围，那么我同意有条件的格式是正确的选择。如果您有几列要检查并且它们并非总是静态的，那么构建查找功能可能会更容易。这是您可以向其发送范围的文本以及您要搜索的文本：

Sub testFindAndColor()
Dim bg1 As Long, bg2 As Long
Dim fg1 As Long, fg2 As Long
Dim myRange As Range
Dim stringToFind As String

bg1 = 50: bg2 = 9
fg1 = 35: fg2 = 22
Set myRange = ActiveSheet.Range("A1:A30")
stringToFind = "Yes"

Run findAndColorize(myRange, stringToFind, bg1, fg1)

Set myRange = Nothing

End Sub


Function findAndColorize(myRange As Range, textToSearchFor As String, backLongColor As Long, foreLongColor As Long)
Dim newRange As Range

With myRange
    Set c = .Find(textToSearchFor, LookIn:=xlValues, MatchCase:=False)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Interior.ColorIndex = backLongColor
            c.Font.ColorIndex = foreLongColor
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

Set c = Nothing
End Function

包含特定字符串的`Worksheet_Change`格式的单元格

4 个答案: