2

同じ構造を持つ 2 つのワークシートがありますが、それらは異なるデータをキャプチャしています。9番目のセルにデータを入力すると、別シートに設定したリストに合わせて行全体の色を変えたい。同じリストが両方のワークシートに使用されます - 同じ色が必要です。リストには 14 のオプションがあります。

これを1つのワークシートで機能させることができる別の質問への回答を見つけましたが、両方のシートで使用できるように修正できることを望んでいました. 1枚を「業務レビュー台帳」といいます。もう一つは「サポートレビュー登録」です。リストは「検証データ」というシートにあります。

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

どんな助けでも大歓迎です。ありがとうDB

4

2 に答える 2

2

Sheet の Changed イベントを操作する場合、2 つのことが必須です。

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 に答える