我在Sheet 1上输入了VBA代码.我希望代码能够在Sheet 2上运行.我只是将代码从Sheet 1复制到Sheet 2吗？

Question

我在这里发现这个VBA代码效果很好.我希望代码可以在工作簿中的其他工作表上工作.代码在Sheet 1中运行良好,但我希望代码也适用于Sheet 2,Sheet 3等.我尝试从Sheet 1模块中复制代码并将其粘贴到Sheet 2,Sheet 3等中,以查看代码是否有效.代码并没有像我预期的那样工作.我想我需要对标准模块代码做一些事情,这样代码才能正常工作.

表1模块

Private Sub Worksheet_Calculate()
    Dim rng As Range, c As Range
    Dim rngToColor As Range

    On Error GoTo ErrorHandler

    Application.EnableEvents = False
    'get only used part of the sheet
    Set rng = Intersect(Me.UsedRange, Me.Range("A:Z"))
    If rng Is Nothing Then GoTo ExitHere 

    For Each c In rng
        'check if previous value of this cell not equal to current value
        If cVals(c.Address) <> c.Text Then
            'if so (they're not equal), remember this cell
            c.ClearComments
            c.AddComment Text:="Changed value from '" & cVals(c.Address) & "' to '" & c.Text & "'" & " on " & Format(Date, "mm-dd-yyyy") & " by " & Environ("UserName")
            c.Interior.ColorIndex = 36
        End If

        'store current value of cell in dictionary (with key=cell address)
        cVals(c.Address) = c.Text
    Next c

ExitHere:
    Application.EnableEvents = True
    Exit Sub
ErrorHandler:
    Resume ExitHere
End Sub

ThisWorkbook模块

Private Sub Workbook_Open()
    Application.Calculation = xlCalculationManual
    Call populateDict
    Application.Calculation = xlCalculationAutomatic
End Sub

标准模块

Public cVals As New Dictionary

Sub populateDict()
    Dim rng As Range, c As Range

    With ThisWorkbook.Worksheets("Sheet1")
        Set rng = Intersect(.UsedRange, .Range("A:Z"))
        For Each c In rng
            cVals(c.Address) = c.Text
        Next c
        .Calculate
    End With

End Sub

编辑:我拿了标准模块并将其修改为:

Sub populateDict()
    Dim rng As Range, c As Range

    With ThisWorkbook.Worksheets("Sheet1")
        Set rng = Intersect(.UsedRange, .Range("A:Z"))
        For Each c In rng
            cVals(c.Address) = c.Text
        Next c
        .Calculate
    End With

    With ThisWorkbook.Worksheets("Sheet2")
        Set rng = Intersect(.UsedRange, .Range("A:Z"))
        For Each c In rng
            cVals(c.Address) = c.Text
        Next c
        .Calculate
    End With

End Sub

这个编辑几乎可以解决问题,但不确定为什么代码无法正常工作

Answer 1

一种方法是将代码放在一个单独的模块中,然后将活动工作表设置为如下变量:

Sub myScript()
    Dim wks As Worksheet

    Set wks = ActiveSheet

    MsgBox (wks.Range("A1"))
End Sub

如果在Sheet1处于活动状态时调用它,它将从Sheet1返回值.

另一种方法是将工作表作为变量传递给子.这只是一种方法.向要从中运行宏的每个工作表添加一个按钮.双击"设计模式"中的每个按钮,以便在编辑器中打开VBA单击事件.像这样添加对您的sub的调用:

Private Sub CommandButton1_Click()
    Call myScriptPass(ActiveSheet)

    'Or you can qualify it like this
    Call myScriptPass(Sheets(1))
End Sub

现在将宏更改为:(仍位于单独的模块中)

Sub myScriptPass(wks As Worksheet)
    MsgBox (wks.Range("A1"))
End Sub

编辑

使用您添加到帖子中的代码,您可以将其更改为以下内容:

Public cVals As New Dictionary

Sub record()
    Dim wks As Worksheet
    Set wks = ActiveSheet

    Dim rng As Range, c As Range

    With wks
        Set rng = Intersect(.UsedRange, .Range("A:Z"))
        For Each c In rng
            cVals(c.Address) = c.Text
        Next c
        .Calculate
    End With
End Sub

现在,它将运行哪个工作表处于活动状态.因此,如果您通过Sheet1上的按钮调用宏,则代码将在Sheet1上运行.

从主程序循环

Public cVals As New Dictionary

Sub myMainProgram()
    Dim wks As Worksheet

    'Loop thru each sheet in workbook example
    For Each wks In Worksheets
        Call record(wks)
    Next wks

    'Call subroutine for specific sheet example
    Call record(sheets("sheet1"))
End Sub

Sub record(wks As Worksheet)
    Dim rng As Range, c As Range

    With wks
        Set rng = Intersect(.UsedRange, .Range("A:Z"))
        For Each c In rng
            cVals(c.Address) = c.Text
        Next c
        .Calculate
    End With

    MsgBox ("Record macro was run on " & wks.Name & " worksheet.")
End Sub