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

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

2 个答案: