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

Question

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

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

我在使用其他代码时遇到的问题： 据我所知，他们需要编辑一个单元格，然后再次快速按下回车键。我试过 SHIFT + F9 重新计算，但这没有效果，因为我认为这仅适用于公式。代码 1 似乎可以工作，尽管必须手动重新输入文本，但无论什么颜色值，我总是得到黑色标签颜色。

我试过的代码：

代码 1:

Private Sub Worksheet_Change(ByVal Target As Range)
    MyVal = Range("A2:A27").Text

    With ActiveSheet.Tab
        Select Case MyVal
            Case ""
                .Color = xlColorIndexNone
            Case Else
                .ColorIndex = 6
        End Select
    End With
End Sub

代码 2: 这是来自 Whosebug 的问题，虽然我稍微修改了代码以满足我的需要。具体来说，如果在设置的范围内没有值可以单独保留标签颜色，否则将其更改为颜色值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

感谢您的帮助！

我首先在 superuser 上发布了这个，但也许 Whosebug 更合适，因为它明确地与编程相关。

Answer 1

也许测试修剪后连接的单元格字符串的长度：

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

每次 sheet 计算时都会触发此代码，因为它是事件代码，我不确定这是否是您想要的？如果没有，那么 post 回来，我们可以将它放入一个普通的子程序中，并让它轮询所有 sheet 进行测试。

Answer 2

每当目标范围发生变化时，

Worksheet_Change 函数都会被调用。您只需要将代码放在工作表下。如果您已将代码放在模块或 Thisworkbook 中，那么它将无法工作。

将以下内容粘贴到工作簿的 Sheet1 中，并检查它是否有效。当然你需要修改下面的代码，因为我没有写完整的代码。

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

Answer 3

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

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

您已经确定了它们，更改了工作表上该范围内的一个单元格的内容，或者这些单元格之一中的公式重新计算为值“”或从值“”重新计算。就事件触发器而言，如果公式结果发生变化， WorkSheet_Calculate 和 Worksheet_Change 事件都会触发。在这两者中，Worksheet_Change 是要响应的一个，因为 WorkSheet_Calculate 仅当 A2:A100 中的任何单元格包含公式时才会触发。如果它们仅包含值则不会 - 您的 "Code 2" 没有错，只是事件从未触发。

简单的解决方案是在打开工作簿时设置选项卡颜色。这样，如果您必须激活该范围内的单元格并更改它，没关系 - 只有这样，您测试的值才会发生变化。

我会这样做（ThisWorkbook 中的代码）：

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

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

Change worksheet tab color if range of cells contains text

excel

vba

excel-2010