英文:
Excel VBA Macro Issue by inserting or deleting a row
问题
我需要帮助调整VBA代码，只要在列S的某些单元格中插入单词"done"，就应该插入当前日期和用户名。
它在我删除或插入新行后就无法正常工作了。然后我收到错误代码'13'，并且具有"If Target.Value = 'done'"的那一行被突出显示。
您能帮助我调整代码，使其在没有任何问题的情况下正常工作吗？提前谢谢！
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next ' 添加错误处理
If Not Intersect(Target, Range("S:S")) Is Nothing Then
If Target.Value = "Done" Then
Target.Offset(0, 7).Value = Date
Target.Offset(0, 8).Value = Environ("username")
Else
Target.Offset(0, 7).ClearContents
Target.Offset(0, 8).ClearContents
End If
End If
On Error GoTo 0 ' 恢复默认错误处理
End Sub
请尝试使用上面的代码，它添加了错误处理，以防止出现错误'13'。这应该解决您遇到的问题。
英文:
i need a help with the VBA code, that should insert the current date and username as soon as the word "done" is inserted in some of the cells in the column S.
It works until I delete or insert a new row. Then I get the Issue ´13´ and the line with If Target.Value ="done" is highlighted.
Can you help me to adjust the code, so it works without any Issue? Thank you in advance!
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("S:S")) Is Nothing Then
If Target.Value = "Done" Then
Target.Offset(0, 7).Value = Date
Target.Offset(0, 8).Value = Environ("username")
Else
Target.Offset(0, 7).ClearContents
Target.Offset(0, 8).ClearContents
End If
End If
End Sub
答案1
得分: 3
请将以下内容添加为过程的第一行：
If Target.Cells.Count > 1 Then Exit Sub
这样，如果插入或删除一行，其余的代码将不会被执行。
英文:
Add If Target.Cells.Count > 1 Then Exit Sub as first line of the procedure.
By that, if a row gets inserted or deleted, the rest of the code won't get executed.
答案2
得分: -1
感谢您的回复。我已经找到了解决方法，以下是我的更新后的代码：
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("S:S")) Is Nothing Then
Application.EnableEvents = False
If Target.Value = "Erledigt" Then
Target.Offset(0, 7).Value = Date
Target.Offset(0, 8).Value = Environ("username")
Else
Target.Offset(0, 7).ClearContents
Target.Offset(0, 8).ClearContents
End If
Application.EnableEvents = True
End If
End Sub
英文:
thank you for your reply. I have found the way out, hier is my updated code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("S:S")) Is Nothing Then
Application.EnableEvents = False
If Target.Value = "Erledigt" Then
Target.Offset(0, 7).Value = Date
Target.Offset(0, 8).Value = Environ("username")
Else
Target.Offset(0, 7).ClearContents
Target.Offset(0, 8).ClearContents
End If
Application.EnableEvents = True
End If
End Sub
答案3
得分: -2
在“如果不相交（目标，范围（“S:S”））不是空的情况下”之前添加“On Error Resume Next”
这样做可以正常工作。
英文:
Add On Error Resume Next just before If Not Intersect(Target, Range("S:S")) Is Nothing Then
this works
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论