我在工作表1上input了一个VBA代码。我希望代码在工作表2上工作。我是否将代码从工作表1复制到工作表2？

我发现这个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 

这个工作簿模块

 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

一种方法是将代码放在一个单独的模块中，然后将活动工作表设置为这样的variables：

 Sub myScript() Dim wks As Worksheet Set wks = ActiveSheet MsgBox (wks.Range("A1")) End Sub 

如果您使用Sheet1激活它，它将返回Sheet1的值。

---

---

另一种方法是将表单作为variables传递给子表单。 这只是一个方法来做到这一点。 将一个button添加到您希望macros运行的每个工作表。 双击“devise模式”中的每个button，以便在编辑器中打开VBA单击事件。 添加一个电话给你的子这样的：

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

现在改变你的macros：（仍位于一个单独的模块）

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

---

编辑

使用您添加到post中的代码，您可以将其更改为以下内容：

 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上的button调用macros，则代码将在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