VBA 宏在工作簿中的多个工作表中不起作用

VBA Macro not working in multiple worksheets within workbook

提问by user1472363

I work for a communications company and I am trying to run code on an Excel document that has compiled data about trouble reports on products.

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

The macros I want to run will generate a risk spider chart for each data set when you click across the columns (months).

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

The macro I have works in the first worksheet but I can't get it to work in the second worksheet when it is essentially the same data.

我在第一个工作表中使用的宏但是当它基本上是相同的数据时我无法让它在第二个工作表中工作。

I would appreciate any help I can get!!

我很感激我能得到的任何帮助！！

This is the code I have:

这是我的代码：

Private Sub Worksheet_Calculate()

    Call UpdateTotalRatings

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$B" 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

回答by Dick Kusleika

If you put your code (with some changes) into the ThisWorkbook module, it will work on every sheet in the workbook.

如果您将代码（经过一些更改）放入 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" 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

If you have sheets that you don't want to process, you can check the Sh argument. Maybe it's based on the sheet name

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

If Sh.Name Like "Report_*" Then

will only process sheets whose names start with Report_. Or

将只处理名称以 Report_ 开头的工作表。或者

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

to check a cell (like A14) that has a particular value to identify sheets to process.

检查具有特定值的单元格（如 A14）以标识要处理的工作表。

回答by JMax

This procedure Worksheet_Changeis an event procedure.

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

It is supposed to (and can) be only in the corresponding Worksheet Module. That's why your code doesn't work for your other sheets.

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

In order to get it work, you need to :

为了让它工作，你需要：

• understand what you intend to do with your VBA
• call the event procedure on every Worksheet module where this is needed
• use a main procedure you will store in a "code" standard module (can't remember the right name here)
• use range arguments to pass the Targetof the procedure (or at least the right worksheet) to the main procedure

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

----- EDIT --------

- - - 编辑 - - - -

First, change

第一，改变

Private Sub UpdateTotalRatings()

to

到

Sub UpdateTotalRatings(Optional ByVal Target As Range)

Then, move all the Sub UpdateTotalRatings(Optional ByVal Target As Range)to a module

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

And, in everyworksheet module, add:

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

Private Sub Worksheet_Calculate()

    Call UpdateTotalRatings

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$B" Then
        Call UpdateTotalRatings(Target)
    End If
End Sub