Excel VBA – 检查重复条目，并从第1页到第2页复制列值

我正在用excel来完成一个“简单”的任务，那就是：

1. 让用户将数值input到SheetA D列（从第3行开始）。
2. 我希望Excel能够仔细检查列D中的条目是否重复。如果是，则应该触发警告消息并取消条目。
3. 如果条目不是重复的，那么新值应该被复制到同一行，但是SheetB A列。

这是我正在使用的代码：

 Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, r As Range, msg As String, x As Range Set rng = Intersect(Columns(4), Target) 'Column to check duplicate If Not rng Is Nothing Then Application.EnableEvents = False For Each r In rng If Not IsEmpty(r.Value) Then If Application.CountIf(Columns(4), r.Value) > 1 Then 'Column to check duplicate...the last number remains 1 msg = msg & vbLf & vbTab If x Is Nothing Then r.Activate Set x = r Else Set x = Union(x, r) End If End If End If Next If Len(msg) Then MsgBox "You have entered a duplicate EID" & msg x.ClearContents x.Select End If Set rng = Nothing Set x = Nothing Sheets("BSheet").Range("A3:A1048576").ClearContents ASheet.Select Dim EID As String 'define the column heading as a variable Dim lastrow As Long 'define the last row lastrow = ASheet.Cells(Rows.Count, 4).End(xlUp).Row 'this will give us the column number in ASheet For i = 3 To lastrow 'here you say that 3rd row is going to be the 1st row to copy EID = ASheet.Cells(i, 4) 'here you say that 4th column is going to be the column to copy BSheet.Activate erow = BSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 'this stay at 1 BSheet.Cells(erow, 1) = EID 'this stays at 1 ASheet.Activate Next i Application.EnableEvents = True End If End Sub 

预先感谢您的帮助。

Answer 1

对于复制控件来说，使用上面的效率更高，那么你可以继续使用macros来复制所需的范围。

希望这对你有用