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
|