Worksheet_Change 阻止添加行
Worksheet_Change Preventing Rows from being added
在编程方面我远不是新手,因为我在网上找到 VBA 代码并尝试根据我的目的重新配置它。
我正在使用下面的代码在更改某些单元格时捕获时间戳和用户名,这非常有效,当我尝试添加或删除行时出现问题。
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim ThisRow As Long ' make sure to declare all the variables and appropriate types
ThisRow = Target.Row
If Target.Column >= 1 And Target.Column <= 1 Then
Dim sOld As String, sNew As String
sNew = Target.Value 'capture new value
With Application
.EnableEvents = False
.Undo
End With
sOld = Target.Value 'capture old value
Target.Value = sNew 'reset new value
If sOld <> sNew Then
' time stamp & username corresponding to cell's last update
Range("L" & ThisRow).Value = Now & Environ("username")
Range("L:L").EntireColumn.AutoFit
End If
Application.EnableEvents = True
End If
End Sub
A 运行-时间错误“13”:
Type Mismatch window pops up. If I hit end the row is added or
deleted, but if I add On Error Resume Next to the code, the pop-up
doesn't pop, but the row also doesn't get deleted or added.
有什么办法可以解决这个问题吗?还是我注定要在每次需要添加或删除行时按结束键?
编辑:
忘了提到调试突出显示 sNew = Target.Value 'capture new value
作为问题。
Target
可以是多单元格范围(如添加新行时),因此在这些情况下您不能将其值分配给字符串类型变量。
不过您可以筛选出整列更改:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Columns.Count = Me.Columns.Count Then Exit Sub
'or even
'If Target.Cells.Count > 1 Then Exit Sub
'rest of code here
在编程方面我远不是新手,因为我在网上找到 VBA 代码并尝试根据我的目的重新配置它。
我正在使用下面的代码在更改某些单元格时捕获时间戳和用户名,这非常有效,当我尝试添加或删除行时出现问题。
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim ThisRow As Long ' make sure to declare all the variables and appropriate types
ThisRow = Target.Row
If Target.Column >= 1 And Target.Column <= 1 Then
Dim sOld As String, sNew As String
sNew = Target.Value 'capture new value
With Application
.EnableEvents = False
.Undo
End With
sOld = Target.Value 'capture old value
Target.Value = sNew 'reset new value
If sOld <> sNew Then
' time stamp & username corresponding to cell's last update
Range("L" & ThisRow).Value = Now & Environ("username")
Range("L:L").EntireColumn.AutoFit
End If
Application.EnableEvents = True
End If
End Sub
A 运行-时间错误“13”:
Type Mismatch window pops up. If I hit end the row is added or deleted, but if I add On Error Resume Next to the code, the pop-up doesn't pop, but the row also doesn't get deleted or added.
有什么办法可以解决这个问题吗?还是我注定要在每次需要添加或删除行时按结束键?
编辑:
忘了提到调试突出显示 sNew = Target.Value 'capture new value
作为问题。
Target
可以是多单元格范围(如添加新行时),因此在这些情况下您不能将其值分配给字符串类型变量。
不过您可以筛选出整列更改:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Columns.Count = Me.Columns.Count Then Exit Sub
'or even
'If Target.Cells.Count > 1 Then Exit Sub
'rest of code here