リストにないユーザーフォームから新しい名前を追加します。 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 

おかげで再びすべてに、