目前,我有从A到AB的专栏。我想实现一个结果,如果任何单元格在一行的Y列:AB中更新,单元格(列A和Y:行的AB)将被复制并粘贴到名为Sheet2的新工作表中,进入A列到即
我的代码目前可以执行上述操作,但是当我在列Y到AB中逐个更改所有4个值时,将生成4行,以反映所做的每个更改。例如。要复制的第一行反映了在Y列中所做的更改。复制的第二行反映了在Z列中所做的更改。复制的第三行反映了在AB列中所做的更改。等等。
我只需要将一行复制到Sheet 2上,该行反映了Sheet 1中一行Y列到AB列的所有更改。有没有办法这样做?
我对VBA并不熟悉,所有指导都非常感谢!谢谢
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("Y:AB")) Is Nothing Then Exit Sub
Range("Y" & Target.Row, "AB" & Target.Row).Copy Sheets("Sheet2").Range("B" & Rows.count).End(xlUp).Offset(1, 0)
Range("A" & Target.Row).Copy Sheets("Sheet2").Range("A" & Rows.count).End(xlUp).Offset(1, 0)
End Sub
答案 0 :(得分:0)
试试这个:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo halt
Application.EnableEvents = False
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets("Sheet2")
With sh1
If Intersect(Target, .Range("Y:AB")) Is Nothing Then GoTo forward
Dim trow As Long, drow As Long, rng As Range
trow = Target.Row
Set rng = sh2.Range("A:A").Find(.Range("A" & trow).Value, sh2.Range("A1"))
If rng Is Nothing Then
drow = sh2.Range("A" & .Rows.Count).End(xlUp).Row + 1
sh2.Range("A" & drow) = .Range("A" & trow)
Else
drow = rng.Row
End If
.Range("Y" & trow, "AB" & trow).Copy sh2.Range("B" & drow)
End With
forward:
Application.EnableEvents = True
Exit Sub
halt:
MsgBox Err.Description
Resume forward
End Sub
我假设 A列包含唯一标识符。
因此,上面的代码执行您描述的内容以及您在评论中解释的内容。 HTH。