VBA宏无法在工作簿中的多个工作表中工作

Question

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

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

我拥有的宏在第一个工作表中有效，但是当它本质上是相同的数据时，我无法在第二个工作表中正常工作。

我将不胜感激！

这是我的代码：

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 （或至少正确的工作表）传递给主过程

-----编辑--------

首先，改变

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