0

誰かが私を助けてくれるのではないかと思います。

以下のコードを使用して、Excelのセルの変更を追跡し、「G」列に「No」のテキスト値を挿入し、「A」列にセルの変更日を挿入しています。 

Option Explicit
    Public preValue As Variant
    Private Sub Worksheet_Change(ByVal Target As Range)

        Dim Cell As Range
        If Target.Cells.Count > 1 Then Exit Sub
            On Error Resume Next
            If Not Intersect(Target, Range("B5:H10")) Is Nothing Then
            If Target.Value <> preValue And Target <> "" Then
            Application.EnableEvents = False
            Range("A" & Target.Row).Value = Date
            Range("G" & Target.Row).Value = "No"
            Application.EnableEvents = True
            Target.ClearComments
            Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) & "Revised " & Format(Date, "dd-mm-yyyy") & Chr(10) & "By " & Environ("UserName")
            Target.Interior.ColorIndex = 35
        End If
    End If
    On Error GoTo 0
    End Sub

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        If Target.Count > 1 Then Exit Sub
        If Target = "" Then
            preValue = "a blank"
        Else: preValue = Target.Value
        End If
        preValue = Target.Value
    End Sub

私がやりたいのは、これをもう少し拡張することです。したがって、列「G」の値が「いいえ」から「はい」に変更された場合、列「B：G」の同じ行のセルからすべてのセルシェーディングを削除したいのですが、方法がわかりません。これをする。

誰かがこれを見て、私がこれを変更する方法についていくつかのガイダンスを提供できるかどうか疑問に思いました。

よろしくお願いします

ポストエディットワーキングソリューション

Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cell As Range
    Dim Rng As Range
    If Target.Cells.Count > 1 Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, Range("B5:W500")) Is Nothing Then
        If Target.Value <> preValue And Target.Value <> "" Then
            Application.EnableEvents = False
            Range("A" & Target.Row).Value = Date
            Range("AX" & Target.Row).Value = "No"
            Application.EnableEvents = True
            'Target.ClearComments
            'Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) & "Revised " & Format(Date, "dd-mm-yyyy") & Chr(10) & "By " & Environ("UserName")
            Target.Interior.ColorIndex = 35
        End If
    End If
    On Error GoTo 0
            If Target.Column = 50 Then
                If Target.Value = "Yes" Then
                Set Rng = Application.Union(Cells(ActiveCell.Row, "B").Resize(, 22), Cells(ActiveCell.Row, "W"))
                Rng.Interior.ColorIndex = xlNone
                End If
                End If
End Sub
4

1 に答える 1

1

すべて、インターネットをトロールした後、これが機能するようになりました。以下に私の解決策を含めました。

Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cell As Range
    Dim Rng As Range
    If Target.Cells.Count > 1 Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, Range("B5:W500")) Is Nothing Then
        If Target.Value <> preValue And Target.Value <> "" Then
            Application.EnableEvents = False
            Range("A" & Target.Row).Value = Date
            Range("AX" & Target.Row).Value = "No"
            Application.EnableEvents = True
            'Target.ClearComments
            'Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) & "Revised " & Format(Date, "dd-mm-yyyy") & Chr(10) & "By " & Environ("UserName")
            Target.Interior.ColorIndex = 35
        End If
    End If
    On Error GoTo 0
            If Target.Column = 50 Then
                If Target.Value = "Yes" Then
                Set Rng = Application.Union(Cells(ActiveCell.Row, "B").Resize(, 22), Cells(ActiveCell.Row, "W"))
                Rng.Interior.ColorIndex = xlNone
                End If
                End If
End Sub
于 2013-08-22T05:34:46.420 に答える