vba目標與添加註釋相交 - 對象錯誤msg

Question

我有以下代碼片段，它可以很好地發揮我所使用的功能。在調試可能的結果時，我發現，例如，如果我嘗試通過ADDING或DELETING A ROW來更改TARGET範圍，我會得到一個VBA錯誤：

如果我在target-> i中添加一行， 「 - ＃424 如果我刪除目標中的一行 - >我得到」方法撤消對象應用程序失敗「 - ＃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 

我想這樣做的「對象所需」消息，如果有可能消除它重置範圍。

關於「應用程序撤消」消息 - >我知道使用它來檢索單元格的先前值不是最好的方法，但它對我很有用，所以如果有解決方案，被期望。

我不想使用「On error resume next」，因爲我想先清理代碼。

謝謝

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