2

我有 2 个具有相同结构的工作表，但是它们正在捕获不同的数据。当数据输入到第 9 个单元格时，我希望整行的颜色根据单独工作表上设置的列表进行更改。相同的列表将用于两个工作表 - 需要相同的颜色。列表中有 14 个选项。

我找到了对另一个问题的回应，它使我能够在一张工作表上工作，但希望可以对其进行修改以在两张工作表上使用。一张称为“运营审查登记表”。另一个是“支持审查登记册”。该列表位于名为“验证数据”的工作表中

https://stackoverflow.com/a/10053946

这就是我迄今为止所拥有的——来自之前的回应。

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Changed As Range)

  Dim CellCrnt As Variant
  Dim ColLast As Long
  Dim Found As Boolean
  Dim MonitorColNum As Long
  Dim MonitorSheetName As String
  Dim RowNCCrnt As Long

  MonitorSheetName = "Operations Review Register"
  MonitorColNum = 9

  ' So changes to monitored cells do not trigger this routine
  Application.EnableEvents = False

  If Sh.Name = MonitorSheetName Then
    ' Use last value in heading row to determine range to colour
    ColLast = Sh.Cells(1, Columns.Count).End(xlToLeft).Column
    For Each CellCrnt In Changed
      If CellCrnt.Column = MonitorColNum Then
        With Worksheets("Validation Data")
          RowNCCrnt = 1
          Found = False
          Do While .Cells(RowNCCrnt, 1).Value <> ""
            If LCase(.Cells(RowNCCrnt, 1).Value) = LCase(CellCrnt.Value) Then
              ' Ensure standard case
              CellCrnt.Value = .Cells(RowNCCrnt, 1).Value
              ' Set required colour to name
              'CellCrnt.Interior.Color = .Cells(RowNCCrnt, 1).Interior.Color
              ' Set required colour to row
              Sh.Range(Sh.Cells(CellCrnt.Row, 1), _
                       Sh.Cells(CellCrnt.Row, ColLast)).Interior.Color = _
                                     .Cells(RowNCCrnt, 1).Interior.Color
              Found = True
              Exit Do
            End If
            RowNCCrnt = RowNCCrnt + 1
          Loop
          If Not Found Then
            ' Name not found.  Add to list so its colour can be specified later
            .Cells(RowNCCrnt, 1).Value = CellCrnt.Value
            ' Clear any existing colour
            Sh.Range(Sh.Cells(CellCrnt.Row, 1), _
                 Sh.Cells(CellCrnt.Row, ColLast)).Interior.ColorIndex = xlNone
          End If
        End With
      End If
    Next
  End If

  Application.EnableEvents = True

End Sub

任何帮助将不胜感激。谢谢数据库

4

2 回答 2

2

使用 Sheet 的 Changed 事件时，必须做两件事。

1）.EnableEvents你已经在做的切换

2)错误处理切换.EnableEvents回True. 如果您不这样做，那么如果您遇到错误，.EnableEvents则将保持关闭状态，并且上述代码将停止工作。

这是你正在尝试的吗？

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Whoa

    Select Case Sh.Name
        Case "Operations Review Register", "Support Review Register"
            If Not Intersect(Target, Columns(9)) Is Nothing Then
                Application.EnableEvents = False

                Dim Rng As Range, cl As Range, aCell As Range

                Set Rng = Sheets("Validation Data").Range("A1:A14")

                For Each cl In Target
                    If cl.Column = 9 Then
                        Set aCell = Rng.Find(What:=cl.Value, LookIn:=xlValues, _
                        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)

                        If Not aCell Is Nothing Then
                            Sh.Rows(cl.Row).Interior.Color = _
                            aCell.Interior.Color
                        Else
                            Sh.Rows(cl.Row).Interior.Color = xlNone
                        End If                            
                    End If
                Next
            End If
    End Select

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

快照

在此处输入图像描述

于 2012-05-20T08:39:12.430 回答
1

更改此行：

If Sh.Name = MonitorSheetName Then

对此：

If Sh.Name = "Operations Review Register" Or Sh.Name = "Support Review Register" Then

一旦你让它工作，你可以用变量替换硬编码的工作表名称。

于 2012-05-20T04:12:44.413 回答