Question

我需要检查每个细胞是否改变某种状况，我写了这个，但它不起作用，有什么不对？

在每张纸上：

Private Sub Worksheet_Change(ByVal Target As Range)
 ColoraLabel.ColoraLabel (ActiveSheet.Name) 
End sub

在我写的模块中：

Public Function ColoraLabel(nomeFoglio)

Dim WS_Count As Integer
Dim I As Integer
Set Foglio = Sheets(nomeFoglio)
Set Target = Foglio.Range("f21")
     WS_Count = ActiveWorkbook.Worksheets.Count
     For I = 1 To WS_Count
        MsgBox ActiveWorkbook.Worksheets(I).Name
        Set Foglio = ActiveWorkbook.Worksheets(I).Name
        Set Target = Foglio.Range("f21")

        If Target = "1" Then
            Foglio.Tab.ColorIndex = 4
        Else
             Foglio.Tab.ColorIndex = xlNone
        End If
     Next I
End Function

Answer 1

将下面的代码放在Workbook_SheetChange事件中，而不是在每个工作表中放置相同的代码（特别是您需要为所有工作表使用相同的代码）。

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

Dim Sht As Worksheet, Foglio As Worksheet
Dim TargetRng As Range

For Each Sht In Worksheets
    MsgBox Sht.Name

    Set Foglio = Sheets(Sht.Name)
    Set TargetRng = Foglio.Range("F21")

    If TargetRng = "1" Then
        Foglio.Tab.ColorIndex = 4
    Else
        Foglio.Tab.ColorIndex = xlNone
    End If

Next Sht

End Sub

但是，由于您的代码会检查单元格“F21”中的值并根据Sheet.tab中的值更改Range("F21")颜色，因此您可以在下面运行最小化和更干净的代码版本：

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

' why scan all cells, if the only thing your function checks is the value of "F21"
If Not Intersect(Range("F21"), Target) Is Nothing Then
    If Target = "1" Then
        Sh.Tab.ColorIndex = 4
    Else
        Sh.Tab.ColorIndex = xlNone
    End If

End If

End Sub

循环检查条件

1 个答案: