Excel 将数据复制并粘贴到列中时，不会触发Vba工作表_更改事件，但可以手动单击单元格

我试图用一段代码解决一个问题。我知道以前有人问过这个问题，但我无法让这些解决方案发挥作用。当我将数据复制并粘贴到列A中时，不会触发下面的工作表更改事件，但当用户手动单击单元格时，会触发下面的工作表更改事件。我如何才能绕过此问题

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range

 

   Application.EnableEvents = False

 

For Each cell In Target

If Not Application.Intersect(cell, Range("A7:A1048576")) Is Nothing Then

If Not IsNumeric(cell.Value) Then

    cell.Value = vbNullString

    MsgBox ("Please re-enter, value entered contains non-numeric entry")

End If

End If

Next cell

 

If Not Intersect(Target, Range("A7:A1048576")) Is Nothing Then

On Error Resume Next

If Target.Value = "" Or Target.Value = "0" Then

Target.Offset(0, 12) = ""

Target.Offset(0, 13) = ""

Else

Target.Offset(0, 12).Value = Format(Now, "mm/dd/yyyy HH:mm:ss")

Target.Offset(0, 13).Value = Environ("username")

 

End If

End If

    Application.EnableEvents = True

End Sub

---

这段代码应该是您想要的。请试一试

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Cell As Range

    If Not Application.Intersect(Target, Range("A7:A1048576")) Is Nothing Then
        Set Target = Target.Columns(1)          ' remove all cells outside column A
        Application.EnableEvents = False
        
        For Each Cell In Target.Cells
            With Cell
                If .Value = "" Or .Value = 0 Then
                    .Offset(0, 12).Resize(1, 2).Value = vbNullString
                Else
                    If Not IsNumeric(.Value) Then
                        .Value = vbNullString
                        MsgBox ("Please re-enter, value entered contains non-numeric entry")
                        .Select
                        Exit For
                    Else
                        .Offset(0, 12).Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
                        .Offset(0, 13).Value = Environ("username")
                    End If
                End If
            End With
        Next Cell
        
        Application.EnableEvents = True
    End If
End Sub

---

这段代码应该是您想要的。请试一试

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Cell As Range

    If Not Application.Intersect(Target, Range("A7:A1048576")) Is Nothing Then
        Set Target = Target.Columns(1)          ' remove all cells outside column A
        Application.EnableEvents = False
        
        For Each Cell In Target.Cells
            With Cell
                If .Value = "" Or .Value = 0 Then
                    .Offset(0, 12).Resize(1, 2).Value = vbNullString
                Else
                    If Not IsNumeric(.Value) Then
                        .Value = vbNullString
                        MsgBox ("Please re-enter, value entered contains non-numeric entry")
                        .Select
                        Exit For
                    Else
                        .Offset(0, 12).Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
                        .Offset(0, 13).Value = Environ("username")
                    End If
                End If
            End With
        Next Cell
        
        Application.EnableEvents = True
    End If
End Sub

---

美丽的！谢谢@Variatus的作品真漂亮！谢谢@Variatus为您提供了一种享受