VBAmacros不工作在工作簿中的多个工作表中

我为一家通信公司工作，我试图在一个已编译产品故障报告数据的Excel文档上运行代码。

当您单击列（月）时，我想要运行的macros将为每个数据集生成一个风险蜘蛛图。

我已经在第一个工作表中工作的macros，但是当它基本上是相同的数据时，我无法在第二个工作表中工作。

我将不胜感激任何帮助！

这是我有的代码：

Private Sub Worksheet_Calculate() Call UpdateTotalRatings End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$14" Then Call UpdateTotalRatings End If End Sub Private Sub UpdateTotalRatings() Dim Cell As Range Dim LastCol As String Application.ScreenUpdating = False ' Ensure number of colours is valid (must be 3 or 6). If ActiveSheet.Range("B14").Value <> 3 And _ ActiveSheet.Range("B14").Value <> 6 Then ActiveSheet.Range("B14").Value = 3 End If ' Determine right-most column. LastCol = Mid(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address, 2, 1) For Each Cell In Range("B13:" & LastCol & "13") If IsNumeric(Cell.Value) Then Cell.Interior.Color = ThisWorkbook.GetColour(Cell.Value, _ ActiveSheet.Range("B14").Value) End If Next Application.ScreenUpdating = True End Sub 

Answer 1

如果您将代码（有一些更改）放入ThisWorkbook模块，它将在工作簿中的每个工作表上工作。

 Private Sub Workbook_SheetCalculate(ByVal Sh As Object) UpdateTotalRankings Sh End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$B$14" Then UpdateTotalRankings Sh End If End Sub Private Sub UpdateTotalRankings(Sh As Object) Dim rCell As Range Dim lLastCol As Long Application.ScreenUpdating = False ' Ensure number of colours is valid (must be 3 or 6). If Sh.Range("B14").Value <> 3 And _ Sh.Range("B14").Value <> 6 Then Sh.Range("B14").Value = 3 End If ' Determine right-most column. lLastCol = Sh.Cells.SpecialCells(xlCellTypeLastCell).Column For Each rCell In Sh.Range("B13").Resize(1, lLastCol - 1).Cells If IsNumeric(rCell.Value) Then rCell.Interior.Color = Me.GetColour(rCell.Value, _ Sh.Range("B14").Value) End If Next rCell Application.ScreenUpdating = True End Sub 

如果你有工作表，你不想处理，你可以检查Sh的参数。 也许它是基于工作表名称

 If Sh.Name Like "Report_*" Then 

将仅处理名称以Report_开头的图纸。 要么

 If Sh.Range("A14").Value = "Input" Then 

检查一个单元格（如A14），它具有特定的值来识别要处理的工作表。

Answer 2

此过程Worksheet_Change是一个事件过程。

它应该（并且可以）只在相应的工作表模块中。 这就是为什么你的代码不适用于其他工作表。

为了得到它的工作，你需要：

• 了解您打算如何处理您的VBA
• 在需要的每个工作表模块上调用事件过程
• 使用一个主要的程序，你将存储在一个“代码”标准模块（这里不记得正确的名称）
• 使用范围参数将过程的Target （或至less正确的工作表）传递给主过程

—–编辑——–

首先，改变

 Private Sub UpdateTotalRatings() 

至

 Sub UpdateTotalRatings(Optional ByVal Target As Range) 

然后，将所有Sub UpdateTotalRatings(Optional ByVal Target As Range)到一个模块

而且，在每个工作表模块中，添加：

 Private Sub Worksheet_Calculate() Call UpdateTotalRatings End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$14" Then Call UpdateTotalRatings(Target) End If End Sub