Thema Datum  Von Nutzer Rating
Antwort
Rot Suchbergiffe
27.06.2014 11:49:16 LOGO
NotSolved

Ansicht des Beitrags:
Von:
LOGO
Datum:
27.06.2014 11:49:16
Views:
575
Rating: Antwort:
  Ja
Thema:
Suchbergiffe

Hallo Zusammen, 

habe folgendes Problem.

Also

Ich möchte pber einen Button in einem anderem Tabellenblatt nach Nachnamen suchen. Wenn ich nur den NAchnamen eingeben, funktioniert es auch, Ich hab mein Makro auch so geschrieben, dass wenn doppelte Nachnamen vorkommen, er mir vorschlägt welche Vorname es dazu gibt.

Ich bekomme es aber nicht hin, das mann über meine Inputbox auch nach vornamen suchen kann. Nachanme steht in Spalt A und Vorname in Spalte B.

KÖnnt Ihr mir da weiter helfen?

Hier mein Makro:

Private Sub CommandButton4_Click()
    Call searchPerson
End Sub

Private Sub searchPerson()
        Dim strInput$, strDefault$, strName$, strPrename$
        Dim rngSearchName As Range, rngFind As Range, rngFindFirst As Range, rngResult As Range
        Dim lngCnt&, strFind
        Dim objOutlook, Mail As Object, objMail As Object
        '**INIT
            Set rngSearchName = Worksheets("Mitarbeitersuche").Range("A:A")
            strDefault = "Name, Vorname"
            strName = ""
            strPrename = ""
        '**Input
            strInput = InputBox("Bitte Name Eingeben", "searchPerson", strDefault)
            If strInput = vbNullString Or strInput = strDefault Then Exit Sub
            On Error Resume Next
                strInput = Trim(strInput)
                strName = LCase(Trim(Split(strInput, ",")(0)))
                strPrename = LCase(Trim(Split(strInput, ",")(1)))
            On Error GoTo 0
            
        '**Search
            If strName <> "" Then
                Set rngFind = rngSearchName.Find(strName, rngSearchName.Cells(1, 1), xlValues, xlPart, , xlNext)
                If Not rngFind Is Nothing Then
                    Set rngFindFirst = rngFind
                    Do
                        If LCase(rngFind.Offset(0, 1)) Like strPrename Or strPrename = "" Then
                            If rngResult Is Nothing Then Set rngResult = rngFind
                            strFind = strFind & rngFind & ", " & rngFind.Offset(0, 1) & vbLf
                            lngCnt = lngCnt + 1
                        End If
                        Set rngFind = rngSearchName.FindNext(rngFind)
                    Loop While (rngFind.Address <> rngFindFirst.Address)
                End If
            End If
        '**Result
            If Not rngResult Is Nothing And lngCnt > 0 Then
                If lngCnt > 1 Then
                    MsgBox "Für '" & strInput & "' gab es " & lngCnt & " Treffer:" & vbLf & _
                           strFind & _
                           "" & vbLf, , "searchPerson"
                    Call searchPerson
                ElseIf lngCnt = 1 Then
                    If MsgBox("Name: " & rngFind.Offset(0, 0) & vbLf & _
                              "Vorname: " & rngFind.Offset(0, 1) & vbLf & _
                              "Abteilung: " & rngFind.Offset(0, 2) & vbLf & _
                              "E-Mail: " & rngFind.Offset(0, 3) & vbLf & _
                              "Tel-Nr: " & rngFind.Offset(0, 5) & vbLf & _
                              "" & vbLf & _
                              "Möchten Sie ein E-Mail versenden?", _
                              vbYesNo Or vbQuestion Or vbDefaultButton2, _
                              "*** E-Mailversand ***") = vbYes Then
                        Set objOutlook = CreateObject("Outlook.Application")
                        Set objMail = objOutlook.CreateItem(0)
                        With objMail
                            .Subject = "Kundenanfrage" & " " & VBA.Date
                            .To = rngFind.Offset(0, 3)
                            .Display
                        End With
                    End If
                End If
            Else
                MsgBox "Kein Treffer für '" & strInput & "'", vbInformation, "searchPerson"
            End If
End Sub


 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot Suchbergiffe
27.06.2014 11:49:16 LOGO
NotSolved

     

nmd runner pk adidas nmd gold adidas stan smith gold adidas stan smith billig adidas superstar