You are here : Start Office (VBA) Geschlecht aus Vornamen ermitteln

Geschlecht aus Vornamen ermitteln
Per VBA-Script das Geschlecht anhand des Vornamens ermitteln.
Die Funktion wurde aus einer Lösung von excelformeln.de erstellt.
 
Public Function get_gender(ByVal FirstName$, Optional female$ = "Frau", _
 Optional male$ = "Herr", Optional neutral = "") As String

Dim f(6), m(6)

Dim i%, j%, v%

Dim x

Dim s$

  ' Weiblich

f(1) = Array("a", "e", "i", "n", "y")

f(2) = Array("ah", "al", "bs", "dl", "el", "et", _

"id", "il", "it", "ll", "th", "ud", "uk")

f(3) = Array("ary", "aut", "des", "een", "eig", "eos", "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")

f(4) = Array("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", _
  "sann", "smin", "ster", "uste", "vien")

f(5) = Array("achel", "agmar", "almut", "candy", "doris", _
  "echen", "edwig", "gerti", "irene", "mandy", "nchen", _
  "rauke", "sabel", "sandy", "silja", "sther", "trudi", _
  "uriel", "velin", "vroni", "ybill")

f(6) = Array("almuth","amaris", "irsten")


  ' Männlich

m(2) = Array("ai", "an", "ay", "dy", "en", "ey", "fa", "gi", _

"hn", "iy", "ki", "nn", "oy", "pe", "ri", "ry", "ua", "uy", "ve", _

"we", "zy")

m(3) = Array("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", "rly", "ron", "rne", "rre", "rti", _
   "sil", "son", "sse", "ste", "tie", "ton", _
   "uce", "udi", "uel", "uli", "uke", "vel", "vid", "vin", _
   "wel", "win", "xei", "xel")

m(4) = Array("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", "stas", "tell", "tila", "tony", "tore", "uele", "ucca")

m(5) = Array("astel", "benny", "billy", "billi", "elice", _

"ianni", "laude", "danny", "dolin", "ormen", "ronny", "sandy", _
"urice", "ustel", "ustin", "willi", "willy")

m(6) = Array("jascha", "tienne", "urence", "vester")


  ' Beides

x = Array("alex", "alexis", "auguste", "carol", "chris", "conny", _

"dominique", "eike", "folke", "gabriele", "gerrit", "heilwig", _

"jean", "kay", "kersten", "kim", "leslie", "maris", "maxime", _

"nicola", "nikola", "sascha", "toni", "winnie")


For i = 0 To UBound(x)

If FirstName = x(i) Then

get_gender = neutral

Exit Function

End If

Next


v = 0

For i = 1 To 6

s = Right(FirstName, i)

x = f(i)

For j = 0 To UBound(x)

If s = x(j) Then

v = v + 1

Exit For

End If

Next


x = m(i)

If Not IsEmpty(x) Then

For j = 0 To UBound(x)

If s = x(j) Then

v = v - 1

Exit For

End If

Next

End If

Next



If v > 0 Then

get_gender = female

Else

get_gender = male

End If
End Function

 
 
 
 
JoomlaTheme.net