带有特定数据的彩色单元格

时间:2013-09-04 18:47:05

标签: excel vba

我有一个宏来为其中包含单词VOID的单元格着色。

我在这样的单元格中也有单词VOID:[$ 189.00VOID]。

我无法找到一种方法来为包含以下内容的所有单元格着色:

  

VOID和[$ 189.00VOID]

或其中的任何其他金额。

Sub Macro1()
On Error Resume Next
Dim current As String

For i = 1 To 65536 ' go from first cell to last

    current = "c" & i ' cell counter

    Range(current).Select ' visit the current cell

    If Range(current).Text = "VOID" Then ' if it says VOID then we...
        With Selection.Interior
            .ColorIndex = 3 ' ...go red
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
    End If

    If Range(current).Text = "FORWARDED" Then ' if it says FORWARDED then we...
        With Selection.Interior
            .ColorIndex = 4 ' ...go green
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
    End If
Next i ' loop and check the next cell
End Sub

2 个答案:

答案 0 :(得分:1)

VBA看起来真的有点矫枉过正了。正如pnuts所说,条件格式化将完成您所需的一切。

选择要格式化的单元格,然后选择Home Ribbon - >条件格式 - >新规则 - >仅格式化包含

的单元格

然后将第一个组合框从“单元格值”更改为特定文本。并在右侧的空文本框中键入VOID。

然后,您可以将单元格格式调整为您想要的任何内容。

答案 1 :(得分:1)

对于这样的事情,我真的建议使用条件格式(如前所述)。以下是您需要应用于C列的两个Condtional Format公式:

=COUNTIF($C1,"*VOID*")>0
=COUNTIF($C1,"*FORWARDED*")>0

但是,如果绝对必须是VBA,请右键单击要监视的工作表选项卡,然后选择“查看代码”。在那里,粘贴以下内容:

Private Sub Worksheet_Calculate()

    Dim rngColor As Range
    Dim rngFound As Range
    Dim strFirst As String
    Dim varFind As Variant

    'Remove current formatting (if any)
    Columns("C").Interior.Color = xlNone

    'Check for both VOID and FORWARDED
    For Each varFind In Array("VOID", "FORWARDED")

        'Attempt to find a cell that contains varFind
        Set rngFound = Columns("C").Find(varFind, Me.Cells(Me.Rows.Count, "C"), xlValues, xlPart)

        'Check if any cells were found
        If Not rngFound Is Nothing Then

            'The first cell was found, record its address and start rngColor
            strFirst = rngFound.Address
            Set rngColor = rngFound

            'Begin loop
            Do

                'Add found cell to rngColor
                Set rngColor = Union(rngColor, rngFound)

                'Advance loop by finding the next cell
                Set rngFound = Columns("C").Find(varFind, rngFound, xlValues, xlPart)

            'Exit loop when back to first cell
            Loop While rngFound.Address <> strFirst

            'Fill rngColor based on varFind
            Select Case varFind
                Case "VOID":        rngColor.Interior.Color = vbRed
                Case "FORWARDED":   rngColor.Interior.Color = vbGreen
            End Select

        End If
    Next varFind

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Worksheet_Calculate
End Sub
相关问题