Question

我有以下一段代码，这些代码在我使用它时非常有用。在调试可能的结果时，我发现，例如，如果我尝试通过ADDING或DELETING A ROW更改TARGET范围，我会收到VBA错误：

如果我在target-＆gt;中添加一行我得到了＃34; Object Required＆＃34; - ＃424 如果我删除目标中的一行 - ＆gt;我得到＆＃34;方法撤销对象应用程序失败＆＃34; - ＃1001（我知道这是因为我使用UNDO来获取旧单元格值，但不知道如何解决）

Option Explicit

Private Sub Worksheet_Change(ByVal target As Range)

Dim newvalue As Variant
Dim oldvalue As Variant
Dim cell As Range
Dim trg As String

' to replace current comment with new one

'If Target.Address = "$A$1" Then
'MsgBox "new value " & newvalue & vbLf & "old value " & oldvalue
'    If ActiveCell.Comment Is Nothing Then
'    ActiveCell.AddComment ("Old Value: " & oldvalue & vbNewLine & "New Value: " & newvalue)
'    Else
'    ActiveCell.Comment.Delete
'    ActiveCell.AddComment ("Old Value: " & oldvalue & vbNewLine & "New Value: " & newvalue)
'    End If

'to append comments to existing comment

On Error GoTo ermess

If Not Application.Intersect(target, Range("A1", "A10")) Is Nothing Then

     For Each cell In target

        Application.EnableEvents = False
        newvalue = cell.Value
        Application.Undo
        oldvalue = cell.Value
        cell.Value = newvalue
        Application.EnableEvents = True
        cell.Interior.ColorIndex = 19

                    If newvalue <> oldvalue Then

                       ' If (Target.Address = "$A$1") Then
                        MsgBox "new value " & newvalue & vbLf & "old value " & oldvalue

                            If cell.Comment Is Nothing Then
                            cell.AddComment ("Old Value: " & oldvalue & vbNewLine & "New Value: " & newvalue & vbNewLine & "Updated: " & Now & vbNewLine & "By: " & Environ("username"))
                            Else
                            With target
                            .Comment.Text Text:=.Comment.Text & vbNewLine & ("Old Value: " & oldvalue & vbNewLine & "New Value: " & newvalue & vbNewLine & "Updated: " & Now _
                            & vbNewLine & "By: " & Environ("username"))
                            End With

                            End If

                        'End If

                    Else
0
                    End If
                    'Set target = Nothing

      Next cell
Else

'to test if not in the target specified
'MsgBox "Not in range"

End If

'Application.EnableEvents = True

Exit Sub
ermess:
MsgBox "VBA Error" & vbLf & Err.Description & vbLf & Err.Number, vbCritical

'Debug.Print
Application.EnableEvents = True

End Sub

我想要做什么来重置范围，以便＆＃34;对象需要＆＃34;如果可能，消息将被删除。

关于＆＃34;应用程序撤消＆＃34;消息 - ＆gt;我知道使用它来检索单元格的先前值并不是最好的方法，但它对我有用，所以如果有一个解决方案，那就是理想的。

我不想使用＆＃34;接下来的错误恢复＆＃34;因为我想先清理代码。

由于

Answer 1

我找到了解决方案。对于任何感兴趣的人，我添加了一个if语句来评估目标范围计数（如果> 1然后退出子）

Option Explicit

Private Sub worksheet_change(ByVal target As Range)

Dim newvalue As Variant
Dim oldvalue As Variant
Dim rng2 As Range
Dim cell As Range
Dim trg As String

' to replace current comment with new one

'If Target.Address = "$A$1" Then
'MsgBox "new value " & newvalue & vbLf & "old value " & oldvalue
'    If ActiveCell.Comment Is Nothing Then
'    ActiveCell.AddComment ("Old Value: " & oldvalue & vbNewLine & "New Value: " & newvalue)
'    Else
'    ActiveCell.Comment.Delete
'    ActiveCell.AddComment ("Old Value: " & oldvalue & vbNewLine & "New Value: " & newvalue)
'    End If

'to append comments to existing comment

Set rng2 = ActiveSheet.Range("A1:A11")

On Error GoTo ermess

    **If target.Count <= 1 Then 'Exit Sub**

        If Not Application.Intersect(target, rng2) Is Nothing Then

             For Each cell In target

           ' On Error Resume Next
            Application.EnableEvents = False
            newvalue = cell.Value
            Application.Undo
            oldvalue = cell.Value
            cell.Value = newvalue
            'On Error GoTo ExitProc
            Application.EnableEvents = True
            cell.Interior.ColorIndex = 19

           '         If newvalue <> Empty Then

                        If newvalue <> oldvalue Then

                           ' If (Target.Address = "$A$1") Then
                            MsgBox "new value " & newvalue & vbLf & "old value " & oldvalue

                                If cell.Comment Is Nothing Then
                                cell.AddComment ("Old Value: " & oldvalue & vbNewLine & "New Value: " & newvalue & vbNewLine & "Updated: " & Now & vbNewLine & "By: " & Environ("username"))
                                Else
                                With target
                                .Comment.Text Text:=.Comment.Text & vbNewLine & ("Old Value: " & oldvalue & vbNewLine & "New Value: " & newvalue & vbNewLine & "Updated: " & Now _
                                & vbNewLine & "By: " & Environ("username"))
                                End With

                                End If

                            'End If

                        Else
0
                        End If
                        'Set target = Nothing

              '      End If

             Next cell

        End If
    'to test if not in the target specified
    'MsgBox "Not in range"
   ***Else
   Exit Sub
   End If***

 With Application
    .EnableEvents = True
    .ScreenUpdating = True
 End With

Exit Sub
ermess:
MsgBox "VBA Error" & vbLf & Err.Description & vbLf & Err.Number, vbCritical

'Debug.Print

End Sub

vba目标与添加的注释相交 - 对象错误消息

1 个答案: