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

时间：2017-05-18 09:10:01

标签： excel vba excel-vba

下面的VBA对于工作表＆＃34; X＆＃34;完全正常。但是，问题是我希望将相同的代码同时应用于工作表＆＃34; Y＆＃34;和＆＃34; Z＆＃34; （还有其他工作表，不需要此代码）。

请您告诉我如何更改我的VBA，以便它指的是工作表＆＃34; X＆＃34;，＆＃34; Y＆＃34;和＆＃34; Z＆＃34;而不只是＆＃34; X＆＃34;？提前致谢。 

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

4 个答案:

答案 0 :(得分：4)

只需遍历三张纸中的每一张：

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

答案 1 :(得分：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")

发布此代码而不进行测试

答案 2 :(得分：0)

可以对此进行修改以在每个工作表中逐个检查条件然后进行更新，但不能同时运行多个脚本。

这应该有效：

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

答案 3 :(得分：-1)

我认为您需要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
相关问题
最新问题