Комментарий, используемый для отслеживания изменений

Question

Я столкнулся с несколькими проблемами с некоторым кодом в VBA. Я пытаюсь, чтобы изменения, внесенные в ячейки на листе Excel, отображались в комментариях к ячейке, в которую было внесено изменение, и я хочу sh, чтобы эти изменения были сохранены в списке, чтобы я мог просмотреть их все позже. Я пробовал много разных фрагментов кода, которые я нашел, чтобы попытаться внедрить его в код, но ни один из них не работал.

Есть идеи, как заставить это работать?

Рабочий лист

Приведенный ниже код - это то, что я использую в настоящее время

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Adding As Boolean, Finding As Boolean, Subtracting As Boolean
    Dim f As Range, v

    Select Case Target.Address(True, True)
        Case "$A$4": Adding = True
        Case "$C$4": Subtracting = True
        Case "$E$4": Finding = True
        Case Else: Exit Sub
    End Select

    v = Trim(Target.Value)
    If Len(v) = 0 Then Exit Sub


    Set f = Me.Range("C8").Resize(1000, 1).Find(v, lookat:=xlWhole)

    If Adding Then

        If f Is Nothing Then
            'not found: add as new row
            Set f = Me.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
            f.Value = v
        End If
        f.Offset(0, 1).Value = f.Offset(0, 1).Value + 1
        doDate f.Offset(0, 2)
        Target.Value = ""

    ElseIf Subtracting Then

        If f Is Nothing Then
            MsgBox v & " not found for subtraction!"
        Else
            f.Offset(0, 1).Value = f.Offset(0, 1).Value - 1
            doDate f.Offset(0, 3)
            Target.Value = ""
        End If

    Else 'finding
        If Not f Is Nothing Then
            f.EntireRow.Select
            Target.Value = ""
        Else
            MsgBox v & " not found."
        End If
    End If

    If Adding Or Subtracting Then Target.Select


End Sub

Sub doDate(c As Range)
    With c
        .NumberFormat = "m/d/yyyy h:mm AM/PM"
        .Value = Now
    End With
End Sub

Я реализовал несколько формул на рабочем листе, но не вижу причин, почему это будет иметь значение в этом ситуация, поскольку они отслеживают только количество товаров с одним и тем же уникальным идентификатором.

Я также пробовал код, который добавлял комментарии к ячейкам по мере их изменения, который работал, но всегда возвращал предыдущее значение ячейки как пустое. Однако на самом деле он не добавлен в текущий код.

Option Explicit 
Public preValue As Variant 
Private Sub Worksheet_Change(ByVal Target As Range) 
    If Target.Count > 1 Then Exit Sub 
    Target.ClearComments 
    Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) & "Revised " & Format(Date, "mm-dd-yyyy") & Chr(10) & "By " & Environ("UserName") 
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 
End Sub 

Answer 1

По большому счету, приведенный ниже код должен делать то, что вы хотите. Я был поражен тем, как вы используете А4 и С4 для сложения и вычитания express. Как бы то ни было, все, что вы измените в этих двух ячейках, помимо их очистки, приведет к добавлению или вычитанию 1. Я ожидал, что туда нужно ввести количество, которое обрабатывается. Если количество фиксировано на 1, система выглядит слишком сложной.

В любом случае, вот код. Думаю, вы сможете изменить его в соответствии со своими потребностями.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 038

    Dim LookUp      As Variant          ' subject
    Dim Action      As Variant          ' add = 1, subtract = -1, find = 2
    Dim Fnd         As Range            ' Result of Find method
    Dim Txt         As String           ' comment text

    With Target
        If (.Row <> 4) Or (.CountLarge > 1) Then Exit Sub

        LookUp = Cells(4, "E").Value
        On Error Resume Next
        Action = Array(0, 1, 0, -1, 0, 2)(.Column)
    End With

    If Action And (LookUp <> "") Then
        ' C8 to end of column C
        With Range(Cells(8, "C"), Cells(Rows.Count, "C").End(xlUp))
            Set Fnd = .Find(LookUp, .Cells(.Cells.Count), xlValues, xlWhole, xlByRows)
        End With
    End If

    If Fnd Is Nothing Then
        Select Case Action
            Case -1
                MsgBox """" & LookUp & """ not found.", vbInformation, "Can't subtract"
                Action = -2
            Case 2
                MsgBox """" & LookUp & """ not found.", vbInformation, "No record"
                Action = -2
            Case Else
                Set Fnd = Cells(Rows.Count, "C").End(xlUp).Offset(1)
                Fnd.Value = LookUp
        End Select
    End If

    With Fnd
        If Abs(Action) <> 2 Then
            With .Offset(0, 1)
                If .Comment Is Nothing Then
                    .AddComment
                Else
                    Txt = Chr(10)
                End If
                Txt = "Previous Qty = " & .Value & Chr(10) & _
                      "Revised " & Format(Date, "mm-dd-yyyy") & Chr(10) & _
                      "by " & Environ("UserName") & Txt
                .Comment.Text Txt, 1, False
                .Value = Val(.Value) + Action
                With .Offset(0, 2)
                    .NumberFormat = "m/d/yyyy h:mm AM/PM"
                    .Value = Now
                End With
            End With
        ElseIf Action = 2 Then
            .EntireRow.Select
        End If
    End With
    If Action <> 2 Then Target.Select
End Sub