Question

我正在努力完成一个简单的＆＃34;使用excel的任务是：

让用户在SheetA的D栏（从第3行开始）输入数值。
我希望Excel仔细检查条目D中的条目是否重复。如果是，则应触发警告消息并取消该条目。
如果条目不重复，则应将新值复制到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

对于复制控制，使用上述功能更有效，然后您可以继续使用宏来复制所需的范围。

希望对你有用

Excel VBA - 检查重复的条目，并从列表1复制到列2的列值

1 个答案: