Namenskürzel generieren

Hallo zusammen,
ich benötige dringend Hilfe bei der Erstellung von Namenskürzel.
Ich habe eine Textbox1 (für Nachnamen) und eine Textbox2 (für Vornamen). Aus diesen Textboxen soll in Textbox5 ein Namenskürzel generiert werden. Das Kürzel soll aus dem 1. Buchstaben des Nachnamens und den 2 Anfangsbuchstaben des Vornamens generiert werden. (Beispiel: Mustermann, Frank = mfr). Perfekt wäre es, wenn das generierte Kürzel mit den bereits vergebenen Kürzel (stehen in einem Tabellenblatt "Namensliste" in Spalte F) automatisch verglichen werden könnte, um Doppelvergaben zu vermeiden. Sollte dies der Fall sein, soll der nächste Buchstabe (also Buchstabe 1+3 des Vornamens) genommen werden. Die ganze Prozedur soll so lange fortgeführt werden, bis sich ein freies Kürzel findet. Die Beispieldatei befindet sich hier: https://www.herber.de/bbs/user/149041.xlsm
Bin für jede Hilfe Dankbar!!
Gruß Kai

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub KürzelGenerieren() Dim i As Byte For i = 2 To Len(TextBox2.Text) 'Zeichen für Vorname "Min 2 // Max den gesamten Vornamen" If Tabelle1.Range("F2:F200").Find(LCase(Left(TextBox1.Text, 1)) & LCase(Left(TextBox2.Text, i))) Is Nothing Then 'wird gesucht ob das kürzel schon vorhanden TextBox5.Text = LCase(Left(TextBox1.Text, 1)) & LCase(Left(TextBox2.Text, i)) 'Kürzel in Textbox schreiben Exit For 'Schleife verlassen End If Next End Sub

Private Sub TextBox2_AfterUpdate() Dim i As Byte If TextBox1 "" And TextBox2 "" Then 'Es muss ein Vor und ein Nachname eingetragen werden For i = 2 To Len(TextBox2.Text) 'Zeichen für Vorname "Min2 Max den gesamten Vornamen" If Tabelle1.Range("F2:F200").Find(LCase(Left(TextBox1.Text, 1)) & LCase(Left(TextBox2.Text, i))) Is Nothing Then 'wird gesucht ob das kürzel schon vorhanden TextBox5.Text = LCase(Left(TextBox1.Text, 1)) & LCase(Left(TextBox2.Text, i)) 'Kürzel in Textbox schreiben Exit For 'Schleife verlassen End If Next End If End Sub

Private Sub TextBox2_AfterUpdate() Dim i As Byte If TextBox1 "" And TextBox2 "" Then For i = 2 To Len(TextBox2.Text) 'Zeichen für Vorname "Min2 Max den gesamten Vornamen" If Tabelle1.Range("F2:F200").Find(LCase(Left(TextBox1.Text, 1)) & LCase(Left(TextBox2.Text, 1)) & LCase(Right(Left(TextBox2.Text, i), 1))) Is Nothing Then 'wird gesucht ob das kürzel schon vorhanden TextBox5.Text = LCase(Left(TextBox1.Text, 1)) & LCase(Left(TextBox2.Text, 1)) & LCase(Right(Left(TextBox2.Text, i), 1)) 'Kürzel in Textbox schreiben Exit For 'Schleife verlassen End If Next End If End Sub

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Namenskürzel generieren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread