Форма пользователя - поиск дубликатов - PullRequest
0 голосов
/ 15 марта 2019

Мне нужна помощь, так как я попробовал несколько вариантов, найденных на форуме, но ни один из них не работает ...

Это то, что мне нужно, - человек заполняет форму пользователя.После того, как они отправят запрос, мне потребуется выполнить поиск, чтобы определить, является ли это дублирующейся записью (имя, фамилия и идентификатор пользователя уже существуют), и, если это так, он удалит предыдущие строки и заменит новую информацию.

это моя нынешняя кодировка:

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
...