Do Schleife bei einer Suchfunktion (VBA UserForm)

[tooob]

Hallo zusammen,

ich versuche Namen zu suchen in einer Tabelle. In A stehen die Nachnamen, in B Vornamen. Das ganze soll in einer VBA User Form geschehen.
Einzelne Nachnamen zu suchen ist kein Problem, Namen wie Müller, Meier etc. kommen jedoch häufiger vor und sollen dann in Kombination mit dem Vornamen ausgegeben werden. Das Problem ist, dass ich nicht weiß wie ich eine passende Schleife da rein setzte, dass der solange sucht bis Vorname und Nachname in der gleiche Row gefunden werden.

Das ist mein Ansatz:

Private Sub Such_Click()
Dim i As Integer
 Dim rZelle        As Range
 Dim rZelle2        As Range
 Dim sSuchbegriff  As String
 Dim sSuchbegriff2  As String

    If Trim$(TextBox1.Value) <> "" Then
       sSuchbegriff = Trim$(TextBox1.Value)
     Else
       MsgBox "Sie müssen einen Suchbegiff eingeben - danke.", _
          48, "   Hinweis für " & Application.UserName
       Exit Sub
    End If
   
    If Trim$(TextBox2.Value) <> "" Then
       sSuchbegriff2 = Trim$(TextBox2.Value)
     Else
       MsgBox "Sie müssen einen Suchbegiff eingeben - danke.", _
          48, "   Hinweis für " & Application.UserName
       Exit Sub
    End If


Do
i = 1
Set rZelle = ThisWorkbook.Worksheets("Daten").Cells(i, 1).Find(what:=sSuchbegriff, LookAt:=xlPart, LookIn:=xlValues)
Set rZelle2 = ThisWorkbook.Worksheets("Daten").Cells(i, 2).Find(what:=sSuchbegriff2, LookAt:=xlPart, LookIn:=xlValues)
   
 If rZelle.Row = rZelle2.Row Then
 
   
       With ThisWorkbook.Worksheets("Daten").Columns(1)
       If Not rZelle Is Nothing Then
         Label2.Caption = .Range("A" & rZelle.Row).Value
          Label3.Caption = .Range("B" & rZelle.Row).Value
          Label4.Caption = .Range("C" & rZelle.Row).Value
          Label5.Caption = .Range("D" & rZelle.Row).Value
          Label6.Caption = .Range("E" & rZelle.Row).Value
          Label7.Caption = .Range("F" & rZelle.Row).Value
          Label44.Caption = .Range("G" & rZelle.Row).Value
          Label9.Caption = .Range("H" & rZelle.Row).Value
          Label10.Caption = .Range("I" & rZelle.Row).Value
          Label11.Caption = .Range("J" & rZelle.Row).Value
          Label12.Caption = .Range("K" & rZelle.Row).Value
          Label13.Caption = .Range("L" & rZelle.Row).Value
          Label14.Caption = .Range("M" & rZelle.Row).Value
          Label15.Caption = .Range("N" & rZelle.Row).Value
          Label16.Caption = .Range("O" & rZelle.Row).Value
          Label17.Caption = .Range("P" & rZelle.Row).Value
          Label39.Caption = .Range("Q" & rZelle.Row).Value
          Label40.Caption = .Range("R" & rZelle.Row).Value
          Label41.Caption = .Range("S" & rZelle.Row).Value
          Label42.Caption = .Range("T" & rZelle.Row).Value
          Label43.Caption = .Range("U" & rZelle.Row).Value
         Label45.Caption = .Range("V" & rZelle.Row).Value
         
         
       
         
       ' usw.
        Else
          MsgBox "Der Begriff  """ & sSuchbegriff & """  wurde nicht gefunden.", _
             48, "   Hinweis für " & Application.UserName
          With TextBox1
             .SetFocus
             .SelStart = 0
             .SelLength = Len(.Text)
          End With
       End If
   End With
Else
i = i + 1
Loop
End If

   Set rZelle = Nothing
Set rZelle2 = Nothing
 End Sub

Das mit der Schleife stimmt vorne und hinten nicht,... wäre über Hilfe sehr dankbar.
Liebe Grüße

[losgehts]

Hallo,

das hier:

Code: [Auswählen]

Do
i = 1
Set rZelle = ThisWorkbook.Worksheets("Daten").Cells(i, 1).Find(what:=sSuchbegriff, LookAt:=xlPart, LookIn:=xlValues) macht wirklich keinen Sinn:
Du benutzt die Find()-Methode um in der Zelle(i,1) nach einem Begriff zu suchen.

Also entweder die Find-Methode benutzen, um in einer ganzen Spalte nach einem Nachnamen zu suchen, oder die einzelnen Zellinhalte in einer Schleife mit deinem Suchbegriff abgleichen (ohne Find()).


Wenn du die Find()-Methode verwenden möchtest, dann könnte das vielleicht ein Grundgerüst sein:

Code: [Auswählen]

Private Sub Such_Click()
Dim i As Integer
Dim rZelle As Range
Dim rZelle2 As Range
Dim sSuchbegriff As String
Dim sSuchbegriff2 As String
Dim strAdr As String

If Trim$(TextBox1.Value) <> "" Then
    sSuchbegriff = Trim$(TextBox1.Value)
Else
    MsgBox "Sie müssen einen Suchbegiff eingeben - danke.", _
            48, "   Hinweis für " & Application.UserName
    Exit Sub
End If

If Trim$(TextBox2.Value) <> "" Then
    sSuchbegriff2 = Trim$(TextBox2.Value)
Else
    MsgBox "Sie müssen einen Suchbegiff eingeben - danke.", _
        48, "   Hinweis für " & Application.UserName
    Exit Sub
End If


'Nachname in Spalte A suchen:
Set rZelle = ThisWorkbook.Worksheets("Daten").Range("A:A").Find(what:=sSuchbegriff, LookAt:=xlPart, LookIn:=xlValues)

If Not rZelle Is Nothing Then       'Wenn Nachname gefunden wurde
    strAdr = rZelle.Address         'erste Fundstelle merken
   
   
    'Solange weiter nach Nachnamen suchen, bis Vorname in Nachbarzelle enthalten ist
    Do While InStr(rZelle.Offset(0, 1).Value, sSuchbegriff2) = 0        'Solange Vorname nicht übereinstimmt
        Set rZelle = ThisWorkbook.Worksheets("Daten").Range("A:A").Find(what:=sSuchbegriff, LookAt:=xlPart, _
                                                                        LookIn:=xlValues, after:=rZelle)
        If strAdr = rZelle.Address Then Exit Do                         'Schleife verlassen wenn erneut erste Fundstelle gefunden
    Loop
   
    If InStr(rZelle.Offset(0.1).Value, sSuchbegriff2) > 0 Then
        'Vorname und Nachname stimmen überein
    Else
        'nur Nachname stimmt überein
    End If
Else
    'Nachname konnte nicht gefunden werden
    MsgBox "Der Begriff  """ & sSuchbegriff & """  wurde nicht gefunden.", _
            48, "   Hinweis für " & Application.UserName

End If
End Sub
Kommst du klar?
Grüße, Ulrich