Supportnet / Forum / Tabellenkalkulation
Makro --> SVERWEIS
Frage
Hallo,
wahrscheinlich eine ganz einfache Frage:
habe 2 Spalten, mit jeweils Nachname in der einen und Vorname in der anderen Spalte.
Will jetzt ein Makro (Function) schreiben, wo man den Nachnamen eingibt und den dazugehörigen Vornamen als Rückgabewert bekommt.
Eigentlich nix anderes als die SVERWEIS Funktion.
Aber wie mach ich das?
Gruß
Janu
Antwort 1 von nighty
hi janu :)
spalte a wie b in wechselwirkung,wird der vorname eingegeben kommt eine info mit nachname,wird der nachname eingegeben kommt eine info des vornamens :))
ab der 2 zeile wird in spalte a und b gesucht mit automatischer abtastung auf ende
viel spass damit :)
gruss nighty
Dim suche1 As Range
Dim name As String
Dim Beenden As String
name = InputBox("Vor oder Nachnamen eingeben")
For zaehler1 = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set suche1 = ActiveSheet.Range("A" & zaehler1 & ":B" & ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row).Find(name)
If Not suche1 Is Nothing Then
If suche1.Column = 1 Then
Beenden = MsgBox("Zu dem Vornamen " & Cells(suche1.Row, 1) & " wurde dieser Nachname gefunden " & Cells(suche1.Row, 2) & OK)
Exit For
End If
If suche1.Column = 2 Then name = Cells(suche1.Row, 1)
Beenden = MsgBox("zu dem Nachnamen " & Cells(suche1.Row, 2) & " wurde dieser Vorname gefunden " & Cells(suche1.Row, 1) & OK)
Exit For
End If
Next zaehler1
End Sub
spalte a wie b in wechselwirkung,wird der vorname eingegeben kommt eine info mit nachname,wird der nachname eingegeben kommt eine info des vornamens :))
ab der 2 zeile wird in spalte a und b gesucht mit automatischer abtastung auf ende
viel spass damit :)
gruss nighty
Dim suche1 As Range
Dim name As String
Dim Beenden As String
name = InputBox("Vor oder Nachnamen eingeben")
For zaehler1 = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set suche1 = ActiveSheet.Range("A" & zaehler1 & ":B" & ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row).Find(name)
If Not suche1 Is Nothing Then
If suche1.Column = 1 Then
Beenden = MsgBox("Zu dem Vornamen " & Cells(suche1.Row, 1) & " wurde dieser Nachname gefunden " & Cells(suche1.Row, 2) & OK)
Exit For
End If
If suche1.Column = 2 Then name = Cells(suche1.Row, 1)
Beenden = MsgBox("zu dem Nachnamen " & Cells(suche1.Row, 2) & " wurde dieser Vorname gefunden " & Cells(suche1.Row, 1) & OK)
Exit For
End If
Next zaehler1
End Sub
Antwort 2 von nighty
hi janus :)
korrigiert :))
gruss nighty
Sub makro01()
Dim zaehler1 As Long
Dim suche1 As Range
Dim name As String
Dim Beenden As String
name = InputBox("Vor oder Nachnamen eingeben")
Set suche1 = ActiveSheet.Range("A1" & ":B" & ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row).Find(name)
If Not suche1 Is Nothing Then
If suche1.Column = 1 Then
Beenden = MsgBox("Zu dem Vornamen " & Cells(suche1.Row, 1) & " wurde dieser Nachname gefunden " & Cells(suche1.Row, 2) & OK)
End If
If suche1.Column = 2 Then name = Cells(suche1.Row, 1)
Beenden = MsgBox("zu dem Nachnamen " & Cells(suche1.Row, 2) & " wurde dieser Vorname gefunden " & Cells(suche1.Row, 1) & OK)
End If
End Sub
korrigiert :))
gruss nighty
Sub makro01()
Dim zaehler1 As Long
Dim suche1 As Range
Dim name As String
Dim Beenden As String
name = InputBox("Vor oder Nachnamen eingeben")
Set suche1 = ActiveSheet.Range("A1" & ":B" & ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row).Find(name)
If Not suche1 Is Nothing Then
If suche1.Column = 1 Then
Beenden = MsgBox("Zu dem Vornamen " & Cells(suche1.Row, 1) & " wurde dieser Nachname gefunden " & Cells(suche1.Row, 2) & OK)
End If
If suche1.Column = 2 Then name = Cells(suche1.Row, 1)
Beenden = MsgBox("zu dem Nachnamen " & Cells(suche1.Row, 2) & " wurde dieser Vorname gefunden " & Cells(suche1.Row, 1) & OK)
End If
End Sub
Antwort 3 von Janu
Thx nighty!
Hat wunderbar geklappt.
Gruß
Janu
Hat wunderbar geklappt.
Gruß
Janu