Vba Worksheet_Change 将数据复制并粘贴到列中时不会触发事件,但在手动单击单元格时会触发
Vba Worksheet_Change event does not trigger when copy and paste data into column but works with a manual click into cell
我正在尝试用一段代码解决问题。我知道之前有人问过这个问题,但我无法让这些解决方案发挥作用。当我将数据复制并粘贴到 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
我正在尝试用一段代码解决问题。我知道之前有人问过这个问题,但我无法让这些解决方案发挥作用。当我将数据复制并粘贴到 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