Salzburger

Function ArrayIndexof(theArray() As Integer, value As Integer)
    Dim i As Integer
    Dim index As Integer
    index = -1
    For i = 0 To UBound((theArray)
        If theArrayt(i) = value Then
            index = i
            Exit For
        End If
    Next i
    Return index
End Function

Salzburger

Zitat:

Vielleicht mit so einer Funktion

Zitat:

wer Namen findet, bei denen es nicht klappt- bitte bekannt geben.

________
Alle Angaben ohne Gewähr. Keine Haftung für Vorschläge, Tipps oder sonstige Hilfe, falls es schiefgeht, nur Zeit verschwendet oder man sonst nicht zufrieden ist

Salzburger

''' <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 Variant
 
  f1 = Array("a", "e", "i", "n", "u", "y")
  Dim f2 As Variant
  f2 = Array("ah", "al", "bs", "dl", "el", "et", "id", "il", "it", "ll", "th", _
    "ud", "uk")
  Dim f3 As Variant
  f3 = Array("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 Variant
  f4 = 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", "rill", "sann", "smin", "ster", "uste", "vien")
  Dim f5 As Variant
  f5 = Array("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 Variant
  f6 = Array("almuth", "amaris", "irsten")
 
  ' subtraktive Jungs
  Dim v1 As Variant
  v1 = Array("ai", "an", "ay", "dy", "en", "ey", "fa", "gi", "hn", "iy", "ki", _
    "nn", "oy", "pe", "ri", "ry", "ua", "uy", "ve", "we", "zy")
  Dim v2 As Variant
  v2 = 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", "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 Variant
  p1 = 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", _
    "ssan", "stas", "tell", "tila", "tony", "tore", "uele", "ucca")
  Dim p2 As Variant
  p2 = Array("astel", "benny", "billy", "billi", "brosi", "elice", "ianni", _
    "laude", "danny", "dolin", "ormen", "ronny", "sandy", "urice", "ustel", _
    "ustin", "willi", "willy")
  Dim p3 As Variant
  p3 = Array("jascha", "tienne", "urence", "vester")
 
  ' Zwitter???
  Dim x1 As Variant
  x1 = Array("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 As Boolean, w2 As Boolean, w3  As Boolean, w4 As Boolean
  Dim av As Integer
  Dim vSub As String
  vSub = ""

  For i = Len(vName) To 1 Step -1   ' -Jungs
    vSub = Mid(vName, i, Len(vName) + 1 - i)
    Select Case Len(vName) + 1 - i
      Case 4
        av = ArrayIndexof(p1, vSub)
        w3 = w3 + (av >= 0)
      Case 5
        av = ArrayIndexof(p2, vSub)
        w3 = w3 + (av >= 0)
      Case 6
        av = ArrayIndexof(p3, vSub)
        w3 = w3 + (av >= 0)
    End Select
  Next i
  For i = Len(vName) To 1 Step -1   ' -Jungs
    vSub = Mid(vName, i, Len(vName) + 1 - i)
    Select Case Len(vName) + 1 - i
      Case 2
        av = ArrayIndexof(v1, vSub)
        w2 = w2 + (av >= 0)
      Case 3
        av = ArrayIndexof(v2, vSub)
        w2 = w2 + (av >= 0)
    End Select
  Next i
  For i = Len(vName) To 1 Step -1   ' +Mädels
    vSub = Mid(vName, i, Len(vName) + 1 - i)
    Select Case Len(vName) + 1 - i
      Case 1
        av = ArrayIndexof(f1, vSub)
        w1 = w1 + (av >= 0)
      Case 2
        av = ArrayIndexof(f2, vSub)
        w1 = w1 + (av >= 0)
      Case 3
        av = ArrayIndexof(f3, vSub)
        w1 = w1 + (av >= 0)
      Case 4
        av = ArrayIndexof(f4, vSub)
        w1 = w1 + (av >= 0)
      Case 5
        av = ArrayIndexof(f5, vSub)
        w1 = w1 + (av >= 0)
      Case 6
        av = ArrayIndexof(f6, vSub)
        w1 = w1 + (av >= 0)
    End Select
  Next i
  w1 = w1 - w2 - w3
  av = ArrayIndexof(x1, vName)
  w4 = (av >= 0)  ' Zwitter
   If w4 = True Then
       getGeschlecht = "W|M"
    Else
             If w1 = True Then
                getGeschlecht = fem
             Else
                getGeschlecht = mas
             End If
   End If
End Function
Function ArrayIndexof(theArray As Variant, value As String)
    Dim i As Integer
    Dim index As Integer
    index = -1
    For i = 0 To UBound(theArray)
        If theArray(i) = value Then
            index = i
            Exit For
        End If
    Next i
    If index > -1 Then
        ArrayIndexof = 1
    Else
        ArrayIndexof = -1
    End If
 
End Function

Salzburger

Salzburger

Salzburger