繁体   English   中英

跟踪Excel单元格更改

[英]Track Excel Cell Changes

我想知道是否有人可以帮我。

我正在使用下面的代码来跟踪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

所有人,在通过互联网进行拖网捕捞之后,现在已经可以使用它了。 我在下面包括了我的解决方案。

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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM