1

我在一家通信公司工作，我正在尝试在 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
4

2 回答 2

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）以识别要处理的工作表。

于 2012-07-10T15:52:48.230 回答
0

这个过程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
于 2012-06-21T14:59:11.467 回答