Добавьте новое имя из пользовательской формы, если нет в списке. Excel VBA

Question

Привет Я относительно новичок в VBA, но мне удалось адаптировать некоторый код и написать немного.

У меня теперь есть проблема. У меня есть код ниже, который я нашел и адаптировал. Я представляю форму пользователя, и пользователь вводит имя и другую информацию.

Код выполняет поиск в списке имен и добавляет другую информацию вместе с именем. Над тем, что уже есть. Если у меня есть новый пользователь, я должен добавить имя внизу, и все будет работать хорошо.

Мне было интересно, может ли кто-нибудь здесь увидеть код, где мне нужно добавить некоторые строки, поэтому, если доза кода не найдет имя в списке, а если добавить его внизу, пожалуйста?

Private Sub txtName_AfterUpdate() 
    Dim intMyVal As String 
    Dim lngLastRow As Long 
    Dim strRowNoList As String 

intMyVal = txtName.Value 'Value to search for, change as required. 
    lngLastRow = Cells(Rows.Count, "AA").End(xlUp).Row 'Search Column AA, change as required. 

    For Each cell In Range("AA4:AA" & lngLastRow) 'Starting cell is AA4, change as required. 

     If cell.Value = intMyVal Then 

     If strRowNoList = "" Then 
      strRowNoList = strRowNoList & cell.Row 
      Else 
      strRowNoList = strRowNoList & ", " & cell.Row  
     End If 

     End If 

    Next cell 

End Sub 

Answer 1

Возможно, это вы ищете?

Используется флаг, чтобы проверить, если найден или не

Private Sub txtName_AfterUpdate() 
    Dim intMyVal As String 
    Dim lngLastRow As Long 
    Dim strRowNoList As String 
    Dim flg As Boolean 

    intMyVal = txtName.Value 'Value to search for, change as required. 
    lngLastRow = Cells(Rows.Count, "AA").End(xlUp).Row 'Search Column AA, change as required. 
    flg=False 

    For Each cell In Range("AA4:AA" & lngLastRow) 'Starting cell is AA4, change as required. 

     If cell.Value = intMyVal Then 

     If strRowNoList = "" Then 
      strRowNoList = strRowNoList & cell.Row 
      flg=True 
      Else 
      strRowNoList = strRowNoList & ", " & cell.Row 
       flg=True  
     End If 

     End If 


    Next cell 
    if flg=False then Range("AA4:AA" & lngLastRow + 1) = txtName.value 

End Sub 

Answer 2

На самом деле трудно понять ваши потребности

Может быть, они это те

Private Sub txtName_AfterUpdate() 
    Dim myVal As String, strRowNoList As String 
    Dim srchRng as Range 

    myVal = txtName.Value 'Value to search for, change as required. 
    With Worksheets("MySheet") '<~~ change it as per your actual sheet name 
    Set srchRng = .Range("AA4:AA" & .Cells(.Rows.Count, "AA").End(xlUp).Row) 
    For Each cell In srchRng 
     If cell.Value = myVal Then strRowNoList = strRowNoList & cell.Row & "," 
    Next cell 

    If strRowNoList <> "" Then 
     strRowNoList = Left(strRowNoList, Len(strRowNoList) - 1) 
    Else 
     strRowNoList = CStr(srchRng.Rows(srchRng.Rows.Count).Row + 1) 
    End If 
    End With 
End Sub 

Но тогда я думаю, вы должны пройти strRowNoList к некоторой рутине, которая выполняет запись/переписывание.

Answer 3

Спасибо всем за помощь и помощь. Я разработал способ сделать это с помощью обработчика ошибок, и хотя я не думаю, что решение является кратким или красивым, я смог заставить его работать. Я уверен, что некоторые из экспертов здесь смогут сделать то же самое гораздо меньше кода, если бы я мог объяснить мои требования более ясными.

Private Sub txtDirection_AfterUpdate() 
On Error GoTo MyerrorHandler: 
Dim intMyVal As String 
Dim lngLastRow As Long 
Dim strRowNoList As String 

intMyVal = txtName.Value 'Value to search for, change as required. 
lngLastRow = Cells(Rows.Count, "AA").End(xlUp).Row 'Search Column A, change as required. 

For Each cell In Range("AA4:AA" & lngLastRow) 'Starting cell is F2, change as required. 

    If cell.Value = intMyVal Then 
     If strRowNoList = "" Then 
      strRowNoList = strRowNoList & cell.Row 
     Else 
      strRowNoList = strRowNoList & ", " & cell.Row 
     End If 
    End If 
Next cell 

If txtDirection.Value <> "" Then 
Ureg.txtDirection.SetFocus 
Select Case txtDirection.Value 'If the user scans in 
    Case "IN" 
     Range("A2").Select 
ActiveCell.End(xlDown).Select 
LastRow = ActiveCell.Row 
Cells(LastRow + 1, 1).Value = txtDate.Text 
Cells(LastRow + 1, 2).Value = Time 
Cells(LastRow + 1, 3).Value = txtName.Text 
Cells(LastRow + 1, 4).Value = txtLocation.Text 
Cells(LastRow + 1, 5).Value = Range("F1").Value 
Cells(LastRow + 1, 6).Value = txtName.Text & txtLocation.Text 
Cells(strRowNoList, 28).Value = txtDirection.Text 
Cells(strRowNoList, 29).Value = txtDate.Text 
Cells(strRowNoList, 30).Value = Time 
Cells(strRowNoList, 31).Value = txtLocation.Text 
Range("A2").Select 
txtDate.Value = Date 
txtName.Text = "" 
txtLocation.Text = "" 
txtDirection.Text = "" 
Ureg.txtName.SetFocus 

     Case "OUT" 'If the user scans OUT 

Range("A2").Select 
ActiveCell.End(xlDown).Select 
LastRow = ActiveCell.Row 
Cells(LastRow + 1, 1).Value = txtDate.Text 
Cells(LastRow + 1, 2).Value = Time 
Cells(LastRow + 1, 3).Value = txtName.Text 
Cells(LastRow + 1, 4).Value = txtLocation.Text 
Cells(LastRow + 1, 5).Value = Range("F1").Value 
Cells(strRowNoList, 28).Value = txtDirection.Text 
Cells(strRowNoList, 29).Value = txtDate.Text 
Cells(strRowNoList, 30).Value = Time 
Cells(strRowNoList, 31).Value = txtLocation.Text 
Cells(LastRow + 1, 6).Value = txtName.Text & txtLocation.Text 
Range("H2").Select 
txtDate.Value = Date 
txtName.Text = "" 
txtLocation.Text = "" 
txtDirection.Text = "" 
Ureg.txtName.SetFocus 

     Case "NEW" 'Extra code if the user is set up as a NEW person No longer needed if the erro handler works. 
Range("A2").Select 
ActiveCell.End(xlDown).Select 
LastRow = ActiveCell.Row 
Cells(LastRow + 1, 1).Value = txtDate.Text 
Cells(LastRow + 1, 2).Value = Time 
Cells(LastRow + 1, 3).Value = txtName.Text 
Cells(LastRow + 1, 4).Value = txtLocation.Text 
Cells(LastRow + 1, 5).Value = Range("F1").Value 
Cells(lngLastRow + 1, 31).Value = txtName.Text 
Cells(lngLastRow + 1, 32).Value = "IN" 
Cells(lngLastRow + 1, 33).Value = txtDate.Text 
Cells(lngLastRow + 1, 34).Value = Time 
Cells(lngLastRow + 1, 35).Value = txtLocation.Text 
Cells(LastRow + 1, 6).Value = txtName.Text & txtLocation.Text 
Range("H2").Select 
txtDate.Value = Date 
txtName.Text = "" 
txtLocation.Text = "" 
txtDirection.Text = "" 
Ureg.txtName.SetFocus 

     Case Else 'Message if the user scannes something other than in , out or new. 
      'MsgBox "Please enter either IN or OUT" 
       Dim AckTime As Integer, InfoBox As Object 
    Set InfoBox = CreateObject("WScript.Shell") 
    'Set the message box to close after 10 seconds 
    AckTime = 5 
    Select Case InfoBox.Popup("Please enter either IN or OUT. Please try again.               (This window will close automatically                 after 5 seconds).", _ 
    AckTime, "Inccorect Destination Scanned", 0) 
     Case 1, -1 
      Exit Sub 
    End Select 
    End Select 
    End If 
    With ActiveWorkbook 
    .SaveCopyAs .Path & "\" & Format(Date, "yyyymmdd") & "-" & [A1] & ".xlsm" 'This will save the sheet evertime a user scan is complete. 

    'MsgBox strRowNoList 
    End With 
'End Sub 

MyerrorHandler: 'This adds the name of the uses to the list in AA if they are not there already and then finishes the same code as above for a booking in. No new user should be scanning out. 
If Err.Number = 13 Then 
Cells(lngLastRow + 1, 27).Value = txtName.Text 
Cells(lngLastRow + 1, 28).Value = "IN" 
Cells(lngLastRow + 1, 29).Value = txtDate.Text 
Cells(lngLastRow + 1, 30).Value = Time 
Cells(lngLastRow + 1, 31).Value = txtLocation.Text 
Range("H2").Select 
txtDate.Value = Date 
txtName.Text = "" 
txtLocation.Text = "" 
txtDirection.Text = "" 
Ureg.txtName.SetFocus 
End If 

End Sub 

Еще раз спасибо всем,