Blue Flower

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(7)
  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("ann", "ary", "aut", "des", "een", "eig", "eos", "ett", "fer", "got", "ies", _
               "iki", "ild", "ind", "itt", "jam", "joy", "kim", "lar", "len", "lis", "men", _
               "mor", "oan", "ppe", "ren", "res", "rix", "san", "sey", "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", "riet", "rill", "roni", "smin", _
               "ster", "uste", "vien")
  f(5) = Array("achel", "agmar", "almut", "Candy", "Doris", "echen", "edwig", "gerti", "irene", _
               "mandy", "nchen", "paris", "rauke", "sabel", "sandy", "silja", "sther", "trudi", _
               "uriel", "velin", "ybill")
  f(6) = Array("almuth", "amaris", "irsten", "karien", "sharon")

  ' Männlich
  m(2) = Array("ai", "an", "ay", "dy", "en", "eu", "ey", "fa", "gi", "hn", "iy", "ki", "nn", "oy", _
               "pe", "ri", "ry", "ua", "uy", "we", "zy")
  m(3) = Array("ael", "ali", "aid", "ain", "are", "ave", "bal", "bby", "bin", "cal", "cel", "cil", _
               "cin", "die", "don", "dre", "ede", "edi", "eil", "eit", "emy", "eon", "gon", "gun", _
               "hal", "hel", "hil", "hka", "iel", "iet", "ill", "ini", "kie", "lge", "lon", "lte", _
               "lja", "mal", "met", "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", "amie", "ammy", "atti", "bela", "didi", "dres", "eith", "elin", "emia", _
               "erin", "ffer", "frid", "gary", "gene", "glen", "hane", "hann", "hein", "idel", "iete", _
               "irin", "kind", "kita", "kola", "lion", "levi", "llin", "mann", "mika", "mike", "muth", _
               "naud", "neth", "nnie", "ntin", "nuth", "olli", "ommy", "onah", "önke", "ören", "pete", _
               "rene", "ries", "rlin", "rome", "rren", "rtin", "ssan", "stas", "tell", "teve", "tila", _
               "tony", "tore", "uele")
  m(5) = Array("astel", "benny", "billy", "billi", "brosi", "elice", "ianni", "laude", "lenny", _
               "danny", "dolin", "ormen", "pille", "ronny", "urice", "ustel", "ustin", "willi", "willy")
  m(6) = Array("jascha", "tienne", "urence", "vester")
  m(7) = Array("patrice")
  
    ' Beides
  x = Array("alex", "alexis", "auguste", "carol", "chris", "conny", _
            "dominique", "eike", "folke", "francis", "friedel", "gabriele", "gerke", "gerrit", "heilwig", _
            "jean", "kay", "kersten", "kim", "kimberly", "leslie", "luca", "lucca", "luka", "maris", "maxime", _
            "Nicki", "nicola", "nikola", "sandy", "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