循环检查条件

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事件，而不是OS把同一段代码在每一个工作表（特别是你的工作表需要相同的代码）。

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