Vba 如果单元格区域包含文本，则更改工作表选项卡颜色

我尝试了在stackoverflow和其他地方找到的代码，但它们并没有像我认为的那样工作。我将在下面列出它们。我几乎可以肯定这是一个简单的问题

我要做的是：如果在A2:A100范围内的任何单元格中有任何文本或数字，则将工作表选项卡设为红色。我需要在20多个选项卡上执行此操作。这必须在打开工作簿时执行，因此不需要手动更改单元格或重新计算

我在其他代码中遇到的问题：据我所知，它们需要编辑单元格，然后再次快速按enter键。我尝试了SHIFT+F9来重新计算，但没有效果，因为我认为这只适用于公式。代码1似乎可以工作，尽管需要手动重新输入文本，但无论颜色值是什么，我总是得到一个黑色选项卡颜色

我尝试过的代码：

代码1：

代码2：这是一个问题，尽管我稍微修改了代码以满足我的需要。具体地说，如果在设置的范围内没有值可以单独保留选项卡颜色，否则将其更改为颜色值6。但我肯定我做错了什么，我不熟悉VBA编码

Private Sub Worksheet_Calculate()
    If Range("A2:A100").Text = "" Then
        ActiveWorkbook.ActiveSheet.Tab.Color = xlColorIndexNone
    Else
        ActiveWorkbook.ActiveSheet.Tab.Color = 6
    End If
End Sub

谢谢你的帮助

---

我首先发布了这篇文章，但stackoverflow可能更合适，因为它与编程明确相关。

可能会测试经过修剪的连接单元格字符串的长度：

Private Sub Worksheet_Calculate()
    If Len(Trim(Join(Application.Transpose(Range("A2:A100"))))) = 0 Then
        ActiveWorkbook.ActiveSheet.Tab.Color = xlColorIndexNone
    Else
        ActiveWorkbook.ActiveSheet.Tab.Color = 6
    End If
End Sub

---

此代码将在每次工作表计算时触发，尽管它是事件代码，但我不确定这是否是您想要的？如果没有，请发回，我们可以为您将其放入一个普通sub，并使其轮询所有要测试的工作表。

每次目标范围发生更改时，都会调用工作表更改功能。您只需要将代码放在工作表下。如果您已将代码放在模块或此工作簿中，则它将不起作用

将下面的内容粘贴到工作簿的第1页，并检查其是否有效。当然，您需要对下面的代码进行修改，因为我还没有编写完整的代码

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WatchRange As Range
    Dim IntersectRange As Range
    Set WatchRange = Range("A1:A20")
    Set IntersectRange = Intersect(Target, WatchRange)
    If IntersectRange Is Nothing Then
        ''Here undo tab color
    Else
        ActiveSheet.Tab.ColorIndex = 6
    End If

End Sub

---

只有两件事可以切换此语句中的条件：

If Range("A2:A100").Text = "" Then

您已经标识了这两个单元格，将工作表中该范围内的一个单元格的内容更改为“”，或将其中一个单元格中的公式重新计算为“”或从“”值更改为“”。就事件触发器而言，如果公式结果发生更改，工作表计算和工作表更改事件都将触发。在这两种情况中，工作表_Change是需要响应的，因为只有在A2:A100中的任何单元格包含公式时，工作表_Calculate才会触发。如果它们只包含值，则不会发生这种情况-您的“代码2”没有错，只是事件从未触发

简单的解决方案是在打开工作簿时设置选项卡颜色。这样，如果你必须激活该范围内的单元格并对其进行更改，这并不重要——这是你测试的值改变的唯一方式

我会这样做（此工作簿中的代码）：

编辑：要测试是否存在特定文本，您可以执行相同的操作，但需要让测试检查所监视范围内的每个单元格

Private Sub SetTabColor(sheet As Worksheet)
    Dim test As Range

    For Each test In sheet.Range("A2:A100")
        sheet.Tab.Color = xlColorIndexNone
        If test.Text = "whatever" Then
            sheet.Tab.Color = vbRed
            Exit For
        End If
    Next test
End Sub

---

答案在很大程度上取决于您希望代码何时运行。这两个示例都响应一个特定事件，这就是您需要更改单元格或重新计算的原因。您需要它在更改和重新计算时运行吗？您最初何时打开工作簿？还有其他事件吗？我需要它在最初打开工作簿时执行。让它在更改或重新计算时执行不是一个选项。我对OP进行了编辑，以明确这一点。OP不希望它依赖于更改：“我在其他代码中遇到的问题：据我所知，它们需要编辑一个单元格，然后再次快速按enter键。”仅当工作表中的更改触发公式重新计算时，“计算”才会触发。你可以填写A行的每个单元格，但只要没有输入公式，并且公式中没有任何单元格在其他地方引用，这段代码就不会运行。我是根据OP发布的代码编写的，这种事情我个人不会放在事件级别上，但这取决于OP。据我所知，你的代码是有效的！我只花了很短的时间在我的一本笔记本上试用，但我没有理由相信它在其他笔记本上不会起作用。我会回来报告确认的。有一件事，颜色代码sheet.Tab.color=6不起作用，那里的所有值都返回黑色。然而，用“vbRed”替换“6”确实有效。对于那些想知道如何添加此代码的人：打开工作簿。按ALT-F11打开VBA编辑器。在左上角附近，您将看到项目窗口。向下滚动直到看到“ThisWorkbook”，双击。输入代码。保存工作簿，然后重新打开。@rebluist-是的，我不知道颜色常数6是什么，所以我只使用问题代码中的值。显然6也不是黑色的-vbBlack是0。很高兴这就是你想要的。只是一个简单的后续问题。我现在试图让标签变成红色，只有当某个文本字符串在范围内。我认为用文本字符串替换“vbNullString”，然后用vbRed替换“xlColorIndexNone”就可以了（当然，也可以将'Else''sheet.Tab.Color=6'替换为'vbNullString'。但它不起作用，我不知道如何修复它。@Rebluist-如果您试图匹配范围内任何单元格中的文本，则需要在该范围内循环并逐个检查它们

If sheet.Range（“A2:A100”）.Text=vbNullString

仅在整个范围为空时才起作用。抱歉，我不确定是否遵循。我试图实现的行为如下。如果是文本字符串，并且仅此文本字符串=“lorem”，则将选项卡涂成红色。否则就别管它了。

Option Explicit

Private Sub Workbook_Open()

    Dim sheet As Worksheet
    For Each sheet In Me.Worksheets
        SetTabColor sheet
    Next sheet

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Not Intersect(Target, Sh.Range("A2:A100")) Is Nothing Then
        SetTabColor Sh
    End If

End Sub

Private Sub SetTabColor(sheet As Worksheet)
    If sheet.Range("A2:A100").Text = vbNullString Then
        sheet.Tab.Color = xlColorIndexNone
    Else
        sheet.Tab.Color = 6
    End If
End Sub

Private Sub SetTabColor(sheet As Worksheet)
    Dim test As Range

    For Each test In sheet.Range("A2:A100")
        sheet.Tab.Color = xlColorIndexNone
        If test.Text = "whatever" Then
            sheet.Tab.Color = vbRed
            Exit For
        End If
    Next test
End Sub