如果活动单元格等于特定文本，则应用内部颜色 - VBA

Applying Interior Color if Active Cell eqauls specific text - VBA

提问by user1486326

I'm new to StackOverflow and VBA. I am an Expert with all aspects of Excel except writing code in VBA from scratch.

我是 StackOverflow 和 VBA 的新手。除了从头开始在 VBA 中编写代码之外，我是 Excel 各个方面的专家。

What I am trying to do is apply an color from the index to the interior of a cell if it contains a specific term. Here is what I have:

如果单元格包含特定术语，我想要做的是将索引中的颜色应用到单元格的内部。这是我所拥有的：

Sub ConditionalFormatting()

Do Until ActiveCell = ""

If ActiveCell = "STAR DISTRICT" Then
ActiveCell.Interior.ColorIndex = 50
ElseIf ActiveCell = "STAR SCHOOL" Then
ActiveCell.Interior.ColorIndex = 50
ElseIf ActiveCell = "HIGH PERFORMING" Then
ActiveCell.Interior.ColorIndex = 43
ElseIf ActiveCell = "SUCCESSFUL" Then
ActiveCell.Interior.ColorIndex = 34
ElseIf ActiveCell = "ACADEMIC WATCH" Then
ActiveCell.Interior.ColorIndex = 38
ElseIf ActiveCell = "LOW PERFORMING" Then
ActiveCell.Interior.ColorIndex = 22
ElseIf ActiveCell = "AT RISK OF FAILING" Then
ActiveCell.Interior.ColorIndex = 18
ElseIf ActiveCell = "FAILING" Then
ActiveCell.Interior.ColorIndex = 3
Else: ActiveCell.Interior.ColorIndex = 1
End If

ActiveCell.Offset(1, 0).Select

Loop

End Sub

The options are: Star District or School, High Performing, Successful, Academic Watch, Low Performing, At Risk of Failing, Failing

选项包括：星区或学校、高绩效、成功、学术观察、低绩效、有失败风险、失败

This code works for one column (except for the bottom two terms) but it will not work anywhere else in the worksheet. When I try it anywhere else, all of the Cells turn Black (or ColorIndex = 1) no matter what the cell contains.

此代码适用于一列（底部两个术语除外），但不适用于工作表中的任何其他地方。当我在其他任何地方尝试时，无论单元格包含什么，所有单元格都会变成黑色（或 ColorIndex = 1）。

Any help would be greatly appreciated.

任何帮助将不胜感激。

Trenton

特伦顿

采纳答案by psubsee2003

Without seeing your input data in your Excel spreadsheet, it is hard to say exactly why this is true:

如果没有在 Excel 电子表格中看到您的输入数据，就很难确切说明为什么会这样：

This code works for one column (except for the bottom two terms) but it will not work anywhere else in the worksheet. When I try it anywhere else, all of the Cells turn Black (or ColorIndex = 1) no matter what the cell contains.

This code works for one column (except for the bottom two terms) but it will not work anywhere else in the worksheet. When I try it anywhere else, all of the Cells turn Black (or ColorIndex = 1) no matter what the cell contains.

However, String comparison by default in VBA is a binary comparison, meaning it will be case sensitive and you are comparing ActiveCellto various upper case strings. If your Excel Spreadsheet contains anything but all upper case, all of the tests will fail.

但是，VBA 中默认的字符串比较是二进制比较，这意味着它将区分大小写，并且您正在与ActiveCell各种大写字符串进行比较。如果您的 Excel 电子表格包含除全部大写以外的任何内容，则所有测试都将失败。

You need to do one of 2 things. First, you can add Option Compare Textto the top of your code sheet. That will change all comparisons to Textinstead of Binarycomparisons.

你需要做两件事之一。首先，您可以添加Option Compare Text到代码表的顶部。这会将所有比较更改为Text而不是Binary比较。

Or you can wrap each ActiveCellin a UCASEfunction, that will capitalize any value in the active cell before performing the comparison:

或者您可以将每个都包装ActiveCell在一个UCASE函数中，该函数将在执行比较之前将活动单元格中的任何值大写：

If UCase(ActiveCell) = "STAR DISTRICT" Then
...
ElseIf UCase(ActiveCell) = "STAR SCHOOL" Then
...
...
...
End If

EDIT:

编辑：

As you mentioned in your comments, the problem was trailing spaces in the cell values, the appropriate code fix is to wrap ActiveCellin a Trimfunction. And you can nest functions inside of each other like:

正如您在评论中提到的，问题是单元格值中的尾随空格，适当的代码修复是包装ActiveCell在一个Trim函数中。您可以将函数相互嵌套，例如：

If UCase(Trim(ActiveCell)) = "STAR DISTRICT" Then
...
ElseIf UCase(Trim(ActiveCell)) = "STAR SCHOOL" Then
...
...
...
End If

This would trim any trailing and leading spaces from the value in ActiveCellthen make it upper case to compare to your flagged value.

这将从值中修剪任何尾随和前导空格，ActiveCell然后使其大写以与您的标记值进行比较。

回答by ps-aux

Well I am not sure at which range you want to apply this code. From what I see in your code you want VBA to apply this "formatting" on ActiveCelland then select another cell below and repeat the "conditional formatting" procedure and then select another cell (with ActiveCell.Offset(1, 0).Select) and so on until it stumbles upon the first empty cell.

好吧，我不确定您要在哪个范围内应用此代码。从我在您的代码中看到的，您希望 VBA 在ActiveCell上应用此“格式” ，然后选择下面的另一个单元格并重复“条件格式”过程，然后选择另一个单元格（带有ActiveCell.Offset(1, 0).Select），依此类推，直到它偶然发现第一个空单元格细胞。

For this, the code should basically work ( I have tried it) and changes the interior color index of the cell it processes" according to your condition. Since this macro applies on the cells in one column from the ActiveCellto the last non-empty cell I do not understand how you intend to use it on two columns.

为此，代码应该基本上可以工作（我已经尝试过）并根据您的条件更改它处理的单元格的内部颜色索引“。由于此宏适用于从ActiveCell到最后一个非空的一列中的单元格单元格 我不明白您打算如何在两列上使用它。

The reason why this macro turns any cell to ColorIndex of 1 could be only that it contains text which is not part of your "conditions list". Also bear in mind that UPPERCASE and LOWERCASE are different characters so the value in the cells will have to be exact upper/lower case match to words/strings in your code or you can enhance the code to transform all letters in word to UPPERCASE ( using UCasefor example)

此宏将任何单元格的 ColorIndex 设为 1 的原因可能只是它包含不属于“条件列表”的文本。还要记住，大写和小写是不同的字符，因此单元格中的值必须与代码中的单词/字符串完全匹配大写/小写，或者您可以增强代码以将单词中的所有字母转换为大写（使用UCase例如）

You can try this code which applies the formatting in question to every cell in the selected range:

您可以尝试使用以下代码将相关格式应用于所选范围内的每个单元格：

Sub ConditionalInteriorColor()

Dim r As Range
Dim cell As Range
Dim index As Integer
Dim word As String

    'Set the targeted range to be the selected range
Set r = Selection

For Each cell In r

    word = UCase(cell.Value)

    'Choose index
    Select Case word
        Case "STAR DISTRICT"
            index = 50
        Case "STAR SCHOOL"
            index = 50
        Case "HIGH PERFORMING"
             index = 43
        Case "SUCCESSFUL"
             index = 39
        Case "ACADEMIC WATCH"
            index = 38
        Case "LOW PERFORMING"
             index = 22
        Case "AT RISK OF FAILING"
            index = 20
        Case "FAILING"
            index = 3
        Case Else
            index = 3
    End Select
    'Color interior of cell
    cell.Interior.ColorIndex = index

Next

End Sub