gpt4 book ai didi

vba - 复制和粘贴无意中触发 Worksheet_Change sub

转载 作者:行者123 更新时间:2023-12-04 22:33:49 31 4
gpt4 key购买 nike

当列“P”取值“x”时,我遇到了“Worksheet_Change”子问题,该子将整行复制并粘贴到第二个工作表(“已完成”)中。它的内容如下:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
'If Cell that is edited is in column P and the value is x then
If Target.Column = 16 And Target.Value = "x" Then
'Define last row on completed worksheet to know where to place the row of data
LrowCompleted = Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Row
'Copy and paste data
Range("A" & Target.Row & ":P" & Target.Row).Copy Sheets("Completed").Range("A" & LrowCompleted + 1)
'Delete Row from Project List
Range("A" & Target.Row & ":P" & Target.Row).Delete xlShiftUp
End If
Application.EnableEvents = True
End Sub

子本身工作正常,但如果我在工作表中的任何位置复制和粘贴,子将被激活,我粘贴的行将发送到我的“已完成”工作表。

到目前为止,我一直在玩“if-clause”,但没有任何运气。例如。:
    If Not Target.Column = 16 And Target.Value = "x" Is Nothing Then

我担心我错过了显而易见的事情,我很感激任何帮助。

谢谢并恭祝安康

PMHD

最佳答案

如果您担心多个目标,请处理它们;不要丢弃它们。

Private Sub Worksheet_Change(ByVal Target As Range)

If not intersect(target, range("p:p")) is nothing then
on error goto meh
Application.EnableEvents = False
dim t as range, lrc as long
lrc = workSheets("Completed").Cells(Rows.Count, "A").End(xlUp).Row + 1
for each t in intersect(target, range("p:p"))
if lcase(t.Value2) = "x" Then
intersect(columns("A:P"), t.rows(t.row)).Copy _
destination:=workSheets("Completed").cells(lrc , "A")
lrc = lrc+1
'Delete Row from Project List
intersect(columns("A:P"), t.rows(t.row)).Delete xlShiftUp
end if
next t
End if

meh:
Application.EnableEvents = true

end sub

关于vba - 复制和粘贴无意中触发 Worksheet_Change sub,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/50831129/

31 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com