Rubrik: Verschiedenes / Sonstiges | VB-Versionen: VB2005, VB2008, VB2010 | 18.11.08 |
Geschlecht anhand des Vornamens ermitteln Junge oder Mädchen? Eine Funktion, die aus dem (deutschen) Vornamen einer Person das Geschlecht zu ermitteln versucht. | ||
Autor: Dietrich Herrmann | Bewertung: | Views: 20.216 |
ohne Homepage | System: Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Das Problem bestand praktisch darin, für eine Menge von Datensätzen, die persönliche Daten beinhalten wie Name, Vorname usw. das Geschlecht der Person (so zu sagen automatisch) zu ermitteln, um es nicht für alle Datensätze von Hand eintragen zu müssen. Nach einigem Suchen fand ich auf www.excelformeln.de eine Lösung in Form von Excelformeln.
In nachstehendem Code habe ich diesen Ansatz in eine VB-Funktion 'verpackt'. Auf obigem Link wird gesagt, dass der Algorithmus für mehr als 1200 Namen funktioniert... Nun, Ausnahmen bestätigen die Regel- wer Namen findet, bei denen es nicht klappt- bitte bekannt geben.
Update vom 28.02.12
Erweiterung der Funktion, damit noch mehr Namen korrekt ausgewertet werden.
Und hier die Funktion:
''' <summary> ''' Ermitteln anhand des Vornamens, ob Junge oder Mädchen ''' </summary> ''' <param name="vName">der Vorname</param> ''' <param name="fem">Standard-Ausgabetext weiblich</param> ''' <param name="mas">Standard-Ausgabetext männlich</param> ''' <returns>Ausgabetext</returns> Public Function getGeschlecht(ByVal vName As String, _ Optional ByVal fem As String = "Frau", _ Optional ByVal mas As String = "Herr") As String ' additive Mädels Dim f1() As String = {"a", "e", "i", "n", "u", "y"} Dim f2() As String = {"ah", "al", "bs", "dl", "el", "et", _ "id", "il", "it", "ll", "th", "ud", "uk"} Dim f3() As String = {"ary", "aut", "des", "een", "eig", "ett", _ "fer", "got", "ies", "iki", "ild", "ind", "itt", "jam", "joy", "kim", _ "lar", "len", "lis", "men", "mor", "oan", "ren", "res", "rix", _ "san", "sis", "tas", "udy", "urg", "vig", "yve"} Dim f4() As String = {"ahel", "ardi", "atie", "borg", "cole", "endy", "gard", "gart", "gnes", "gund", _ "iede", "indy", "ines", "iris", "ison", "istl", _ "ldie", "lilo", "loni", "lott", "lynn", "mber", "moni", "nken", _ "oldy", "riam", "rien", "riet", "rill", "sann", "smin", "ster", "uste", "vien"} Dim f5() As String = {"achel", "agmar", "almut", "Candy", "Doris", _ "echen", "edwig", "gerti", "irene", "mandy", "nchen", "paris", "rauke", "sabel", "sandy", "silja", "sther", _ "trudi", "uriel", "velin", "vroni", "ybill"} Dim f6() As String = {"almuth", "amaris", "irsten"} ' subtraktive Jungs Dim v1() As String = {"ai", "an", "ay", "dy", "en", "ey", "fa", "gi", "hn", "iy", _ "ki", "nn", "oy", "pe", "ri", "ry", "ua", "uy", "ve", "we", "zy"} Dim v2() As String = {"ael", "ali", "aid", "ain", "are", "bal", "bby", "bin", _ "cal", "cel", "cil", "cin", "die", "don", "dre", _ "ede", "edi", "eil", "eit", "emy", "eon", "ffer", "gon", "gun", _ "hal", "hel", "hil", "hka", "iel", "iet", "ill", "ini", "kie", _ "lge", "lon", "lte", "lja", "mal", "met", "mia", "mil", "min", "mon", "mre", "mud", "muk", _ "nid", "nsi", "oah", "obi", "oel", "örn", "ole", "oni", "oly", _ "phe", "pit", "rcy", "rdi", "rel", "rge", "rka", "ron", "rne", "rre", "rti", _ "sil", "son", "sse", "ste", "tie", "ton", "uce", "udi", "uel", "uli", "uke", _ "vel", "vid", "vin", "wel", "win", "xei", "xel"} ' subtraktive Jungs zwei Dim p1() As String = {"abel", "akim", "ammy", "atti", "bela", "didi", "dres", _ "eith", "elin", "erin", _ "ffer", "frid", "gary", "gene", "glen", "hane", "hein", "idel", "iete", "irin", _ "jona", "kind", "kita", "kola", "lion", "levi", "mike", "muth", _ "naud", "neth", "nnie", "ntin", "nuth", "olli", "ommy", "önke", "ören", _ "pete", "rene", "ries", "rlin", "rome", "rren", "rtin", "ssan", "stas", _ "tell", "tila", "tony", "tore", "uele", "ucca"} Dim p2() As String = {"astel", "benny", "billy", "billi", "brosi", "elice", "ianni", "laude", _ "danny", "dolin", "ormen", "ronny", "sandy", "urice", "ustel", "ustin", "willi", "willy"} Dim p3() As String = {"jascha", "tienne", "urence", "vester"} ' Zwitter??? Dim x1() As String = {"Alex", "Alexis", "Andrea", "Auguste", "Carol", "Chris", "Conny", "Dominique", _ "Eike", "Folke", "Friedel", "Gabriele", "Gerrit", "Heilwig", "Jean", "Kay", "Kersten", "Kim", _ "Leslie", "Maris", "Maxime", "Nicola", "Nikola", "Sascha", "Toni", "Winnie"} Dim w1, w2, w3, w4 As Boolean Dim av As Short Dim vSub As String = "" For i As Short = vName.Length To 1 Step -1 ' -Jungs vSub = vName.Substring(vName.Length - i, i) Select Case i Case 4 av = Array.IndexOf(p1, vSub) : w3 += (av >= 0) Case 5 av = Array.IndexOf(p2, vSub) : w3 += (av >= 0) Case 6 av = Array.IndexOf(p3, vSub) : w3 += (av >= 0) End Select Next i For i As Short = vName.Length To 1 Step -1 ' -Jungs vSub = vName.Substring(vName.Length - i, i) Select Case i Case 2 av = Array.IndexOf(v1, vSub) : w2 += (av >= 0) Case 3 av = Array.IndexOf(v2, vSub) : w2 += (av >= 0) End Select Next i For i As Short = vName.Length To 1 Step -1 ' +Mädels vSub = vName.Substring(vName.Length - i, i) Select Case i Case 1 av = Array.IndexOf(f1, vSub) : w1 += (av >= 0) Case 2 av = Array.IndexOf(f2, vSub) : w1 += (av >= 0) Case 3 av = Array.IndexOf(f3, vSub) : w1 += (av >= 0) Case 4 av = Array.IndexOf(f4, vSub) : w1 += (av >= 0) Case 5 av = Array.IndexOf(f5, vSub) : w1 += (av >= 0) Case 6 av = Array.IndexOf(f6, vSub) : w1 += (av >= 0) End Select Next i w1 = w1 - w2 - w3 av = Array.IndexOf(x1, vName) : w4 = (av >= 0) ' Zwitter Return IIf(w4 = True, "F|M", IIf(w1 = True, fem, mas)) End Function
In der Praxis könnte man das noch mit dem Alter der Person kombinieren und evtl. eine Anrede davon ableiten.
Viel Spaß damit!