将相同的代码应用于多个工作表

下面的VBA对Worksheet“X”来说工作得很好。 然而，问题是我想要同样的代码同时应用到工作表“Y”和“Z”（还有其他工作表，以及不需要此代码）。

你可以让我知道如何改变我的VBA，所以它指的是工作表“X”，“Y”和“Z”，而不是只有“X”？ 提前致谢。

Option Explicit 'In a regular module sheet Public RunWhen As Double 'This statement must go at top of all subs and functions Sub StartBlink() Dim cel As Range With ThisWorkbook.Worksheets("X") Set cel = .Range("G2") If cel.Value > .Range("L3").Value Then If cel.Font.ColorIndex = 3 Then ' Red Text cel.Font.ColorIndex = 2 ' White Text cel.Interior.ColorIndex = 3 Else cel.Font.ColorIndex = 3 ' Red Text cel.Interior.ColorIndex = xlColorIndexAutomatic End If Else cel.Font.ColorIndex = 3 'Red text cel.Interior.ColorIndex = xlColorIndexAutomatic End If End With RunWhen = Now + TimeSerial(0, 0, 1) Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , True End Sub Sub StopBlink() On Error Resume Next Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False On Error GoTo 0 With ThisWorkbook.Worksheets("X") .Range("G2").Font.ColorIndex = 3 .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic End With End Sub Sub xStopBlink() On Error Resume Next Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False On Error GoTo 0 ThisWorkbook.Worksheets("X").Range("L3").Font.ColorIndex = 3 End Sub 

Answer 1

只是循环通过三个表中的每一个：

 Sub StartBlink() Dim cel As Range Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets(Array("X", "Y", "Z")) With ws Set cel = .Range("G2") If cel.Value > .Range("L3").Value Then If cel.Font.ColorIndex = 3 Then ' Red Text cel.Font.ColorIndex = 2 ' White Text cel.Interior.ColorIndex = 3 Else cel.Font.ColorIndex = 3 ' Red Text cel.Interior.ColorIndex = xlColorIndexAutomatic End If Else cel.Font.ColorIndex = 3 'Red text cel.Interior.ColorIndex = xlColorIndexAutomatic End If End With Next RunWhen = Now + TimeSerial(0, 0, 1) Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , True End Sub Sub StopBlink() On Error Resume Next Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False On Error GoTo 0 Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets(Array("X", "Y", "Z")) With ws .Range("G2").Font.ColorIndex = 3 .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic End With Next End Sub 

Answer 2

尝试为你的潜艇添加一个参数，比如

 Option Explicit 'In a regular module sheet Public RunWhen As Double 'This statement must go at top of all subs and functions Public wsReference As Worksheet Sub StartBlink(ByVal NewWsName As Worksheet) Dim cel As Range Set wsReference = NewWsName With NewWsName Set cel = .Range("G2") If cel.Value > .Range("L3").Value Then If cel.Font.ColorIndex = 3 Then ' Red Text cel.Font.ColorIndex = 2 ' White Text cel.Interior.ColorIndex = 3 Else cel.Font.ColorIndex = 3 ' Red Text cel.Interior.ColorIndex = xlColorIndexAutomatic End If Else cel.Font.ColorIndex = 3 'Red text cel.Interior.ColorIndex = xlColorIndexAutomatic End If End With RunWhen = Now + TimeSerial(0, 0, 1) Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , True End Sub Sub StopBlink() On Error Resume Next Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False On Error GoTo 0 With wsReference .Range("G2").Font.ColorIndex = 3 .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic End With End Sub Sub xStopBlink() On Error Resume Next Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False On Error GoTo 0 wsReference.Range("L3").Font.ColorIndex = 3 End Sub 

应该被称为像

 startblink thisworkbook.sheets("X") startblink thisworkbook.sheets("Y") 

张贴这个代码没有testing

Answer 3

这可以被修改为在每张表中检查条件1，然后更新，但是不能同时运行多个脚本。

这应该工作：

 Option Explicit 'In a regular module sheet Public RunWhen As Double 'This statement must go at top of all subs and functions Sub StartBlink() Dim cel As Range With ThisWorkbook.Worksheets("X") Set cel = .Range("G2") If cel.Value > .Range("L3").Value Then If cel.Font.ColorIndex = 3 Then ' Red Text cel.Font.ColorIndex = 2 ' White Text cel.Interior.ColorIndex = 3 Else cel.Font.ColorIndex = 3 ' Red Text cel.Interior.ColorIndex = xlColorIndexAutomatic End If Else cel.Font.ColorIndex = 3 'Red text cel.Interior.ColorIndex = xlColorIndexAutomatic End If End With With ThisWorkbook.Worksheets("y") Set cel = .Range("G2") If cel.Value > .Range("L3").Value Then If cel.Font.ColorIndex = 3 Then ' Red Text cel.Font.ColorIndex = 2 ' White Text cel.Interior.ColorIndex = 3 Else cel.Font.ColorIndex = 3 ' Red Text cel.Interior.ColorIndex = xlColorIndexAutomatic End If Else cel.Font.ColorIndex = 3 'Red text cel.Interior.ColorIndex = xlColorIndexAutomatic End If End With With ThisWorkbook.Worksheets("z") Set cel = .Range("G2") If cel.Value > .Range("L3").Value Then If cel.Font.ColorIndex = 3 Then ' Red Text cel.Font.ColorIndex = 2 ' White Text cel.Interior.ColorIndex = 3 Else cel.Font.ColorIndex = 3 ' Red Text cel.Interior.ColorIndex = xlColorIndexAutomatic End If Else cel.Font.ColorIndex = 3 'Red text cel.Interior.ColorIndex = xlColorIndexAutomatic End If End With RunWhen = Now + TimeSerial(0, 0, 1) Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , True End Sub Sub StopBlink() On Error Resume Next Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False On Error GoTo 0 With ThisWorkbook.Worksheets("X") .Range("G2").Font.ColorIndex = 3 .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic End With With ThisWorkbook.Worksheets("y") .Range("G2").Font.ColorIndex = 3 .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic End With With ThisWorkbook.Worksheets("z") .Range("G2").Font.ColorIndex = 3 .Range("G2").Interior.ColorIndex = xlColorIndexAutomatic End With End Sub Sub xStopBlink() On Error Resume Next Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False On Error GoTo 0 ThisWorkbook.Worksheets("X").Range("L3").Font.ColorIndex = 3 ThisWorkbook.Worksheets("y").Range("L3").Font.ColorIndex = 3 ThisWorkbook.Worksheets("z").Range("L3").Font.ColorIndex = 3 End Sub 

Answer 4

我想你需要Activate方法： ThisWorkbook.Worksheets("name").Activate 。

从MSDN： 调用此方法相当于单击工作表的选项卡。

尝试这个：

 Sub tt() Dim sheets As Variant, s As Variant sheets = Array("X", "Y", "Z", ...) For Each s In sheets ThisWorkbook.Worksheets(s).Activate ' call your sub here Next s End Sub