excel - 我有 2 个工作表，需要根据该行单元格 9 中的值为整行着色

Question

我有 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

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

Answer 1

在处理工作表的 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

快照