用户表单-搜索重复项

时间:2019-03-15 16:08:46

标签: vba userform

我需要帮助,因为我尝试了在论坛中找到的许多选项,但似乎都无法使用...

这就是我需要做的-该人填写了用户表格。他们提交后,我需要进行搜索以查看是否存在重复的条目(名字,姓氏和用户ID已经存在),如果存在,则它将删除前几行并替换为新信息。

这是我目前的编码:

Private Sub CmdAdd_Click()

    Dim iRow As Long
    Dim ws As Worksheet
    Const strPwd As String = "Transfer19"

    ThisWorkbook.Unprotect Password:=strPwd
    Set ws = Worksheets("Inventory")

    iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
                         SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

    If Trim(Me.TxtFirst.Value) = "" Then
        Me.TxtFirst.SetFocus
        MsgBox "Please complete First Name field"
        Exit Sub
    End If

    If Trim(Me.TxtLast.Value) = "" Then
        Me.TxtFirst.SetFocus
        MsgBox "Please complete Last Name field"
        Exit Sub
    End If
    If Trim(Me.TxtPRI.Value) = "" Then
        Me.TxtFirst.SetFocus
        MsgBox "Please complete the PRI field"
        Exit Sub
    End If
    If Trim(Me.TxtLinguistic.Value) = "" Then
        Me.TxtFirst.SetFocus
        MsgBox "Please select a linguistic choice"
        Exit Sub
    End If
    If Trim(Me.TxtEmail.Value) = "" Then
        Me.TxtFirst.SetFocus
        MsgBox "Please insert your Email address"
        Exit Sub
    End If
    If Trim(Me.ListProv1.Value) = "" Then
        Me.TxtFirst.SetFocus
        MsgBox "Please select a Province"
        Exit Sub
    End If
    If Trim(Me.ListCity1.Value) = "" Then
        Me.TxtFirst.SetFocus
        MsgBox "Please select a City"
        Exit Sub
    End If
    If Trim(Me.TxtResumeNum.Value) = "" Then
        Me.TxtFirst.SetFocus
        MsgBox "Please provide us with the RDIMS# to your resume"
        Exit Sub
    End If
    If Trim(Me.TxtDate.Value) = "" Then
        Me.TxtFirst.SetFocus
        MsgBox "Please insert your registration date"
        Exit Sub
    End If
    If Trim(Me.TxtGRLV.Value) = "" Then
        Me.TxtFirst.SetFocus
        MsgBox "Please insert Substantive Group & Level"

        Exit Sub
    End If

    With ws
        .Unprotect Password:="Transfer19"
        .Cells(iRow, 1).Value = Me.TxtFirst.Value
        .Cells(iRow, 2).Value = Me.TxtLast.Value
        .Cells(iRow, 3).Value = Me.TxtPRI.Value
        .Cells(iRow, 4).Value = Me.TxtGRLV.Value
        .Cells(iRow, 5).Value = Me.TxtLinguistic.Value
        .Cells(iRow, 6).Value = Me.TxtEmail.Value
        .Cells(iRow, 7).Value = Me.TxtResumeNum.Value
        .Cells(iRow, 8).Value = Me.TxtReason.Value
        .Cells(iRow, 9).Value = Me.TxtDate.Value
        .Cells(iRow, 10).Value = Me.ListProv1.Value
        .Cells(iRow, 11).Value = Me.ListCity1.Value
        .Cells(iRow + 1, 10).Value = Me.ListProv2.Value
        .Cells(iRow + 1, 11).Value = Me.ListCity2.Value
        .Cells(iRow + 2, 10).Value = Me.ListProv3.Value
        .Cells(iRow + 2, 11).Value = Me.ListCity3.Value
        .Cells(iRow + 3, 10).Value = Me.ListProv4.Value
        .Cells(iRow + 3, 11).Value = Me.ListCity4.Value
        .Cells(iRow + 4, 10).Value = Me.ListProv5.Value
        .Cells(iRow + 4, 11).Value = Me.ListCity5.Value
        .Cells(iRow + 5, 10).Value = Me.ListProv6.Value
        .Cells(iRow + 5, 11).Value = Me.ListCity6.Value
        .Cells(iRow + 6, 10).Value = Me.ListProv7.Value
        .Cells(iRow + 6, 11).Value = Me.ListCity7.Value
        .Cells(iRow + 7, 10).Value = Me.ListProv8.Value
        .Cells(iRow + 7, 11).Value = Me.ListCity8.Value
        .Cells(iRow + 8, 10).Value = Me.ListProv9.Value
        .Cells(iRow + 8, 11).Value = Me.ListCity9.Value
        .Cells(iRow + 9, 10).Value = Me.ListProv10.Value
        .Cells(iRow + 9, 11).Value = Me.ListCity10.Value
        .Protect Password:="Transfer19"
    End With
    ThisWorkbook.Protect Password:=strPwd
    ThisWorkbook.Save
End Sub

0 个答案:

没有答案