🚀 go-pugleaf

De hier volgende functie staat eveneens op het internet
(http://www.myatt.demon.co.uk/soundex.htm) de auteur is Author    :   Mark
Myatt, Brixton Health

Hoe gebruiken : stuur je te zoeken string naar deze functie en je krijgt een
code terug ...
Bvb federation = F363
Je laat je zoekactie doorvoeren op alles wat aan deze code voldoet ...
ook f�d�ration = F363 ...


Public Function FnSoundexCode(SurnameToCode As String)

    '
    ' Name      :   FnSoundexCode
    ' Function  :   Returns a SOUNDEX code for a text string
    ' Version   :   1.00
    ' Dated     :   23/01/98
    ' Author    :   Mark Myatt, Brixton Health
    '

    Dim LetterValue As String
    Dim RawLetterValues As String
    Dim CharacterPosition As Integer
    Dim DuplicatesRemoved As String
    Dim PlaceMarkersRemoved As String
    Dim PreviousLetterValue As String
    Dim CurrentLetter As String

    RawLetterValues = ""

    For CharacterPosition = 1 To Len(SurnameToCode)
        CurrentLetter = Mid(SurnameToCode, CharacterPosition, 1)
        '
        ' Default to "!" placemarker for vowels including "Y"
        '
        LetterValue = "!"
        '
        ' Assign Soundex scores
        '
        If CurrentLetter = "B" Then LetterValue = "1"
        If CurrentLetter = "C" Then LetterValue = "2"
        If CurrentLetter = "D" Then LetterValue = "3"
        If CurrentLetter = "F" Then LetterValue = "1"
        If CurrentLetter = "G" Then LetterValue = "2"
        '
        ' Letter "H" is null
        '
        If CurrentLetter = "H" Then LetterValue = ""
        If CurrentLetter = "J" Then LetterValue = "2"
        If CurrentLetter = "K" Then LetterValue = "2"
        If CurrentLetter = "L" Then LetterValue = "4"
        If CurrentLetter = "M" Then LetterValue = "5"
        If CurrentLetter = "N" Then LetterValue = "5"
        If CurrentLetter = "P" Then LetterValue = "1"
        If CurrentLetter = "Q" Then LetterValue = "2"
        If CurrentLetter = "R" Then LetterValue = "6"
        If CurrentLetter = "S" Then LetterValue = "2"
        If CurrentLetter = "T" Then LetterValue = "3"
        If CurrentLetter = "V" Then LetterValue = "1"
        '
        ' Letter "W" is null
        '
        If CurrentLetter = "W" Then LetterValue = ""
        If CurrentLetter = "X" Then LetterValue = "2"
        If CurrentLetter = "Z" Then LetterValue = "2"
        RawLetterValues = RawLetterValues + LetterValue
    Next CharacterPosition

    '
    ' Search for and replace duplicates with "!" placemarker
    '
    DuplicatesRemoved = Mid(RawLetterValues, 1, 1)
    For CharacterPosition = 2 To Len(RawLetterValues)
        PreviousLetterValue = Mid(RawLetterValues, CharacterPosition - 1, 1)
        CurrentLetter = Mid(RawLetterValues, CharacterPosition, 1)
        If CurrentLetter = PreviousLetterValue Then CurrentLetter = "!"
        DuplicatesRemoved = DuplicatesRemoved + CurrentLetter
    Next CharacterPosition

    '
    ' Remove "!" placemarkers
    '
    PlaceMarkersRemoved = ""
    For CharacterPosition = 2 To Len(DuplicatesRemoved)
        CurrentLetter = Mid(DuplicatesRemoved, CharacterPosition, 1)
        If CurrentLetter = "!" Then CurrentLetter = ""
        PlaceMarkersRemoved = PlaceMarkersRemoved + CurrentLetter
    Next CharacterPosition

    '
    ' Bulk out Soundex with "0" if required
    '
    If Len(PlaceMarkersRemoved) < 3 Then
        For CharacterPosition = 1 To 3 - Len(PlaceMarkersRemoved)
            PlaceMarkersRemoved = PlaceMarkersRemoved + "0"
        Next CharacterPosition
    End If

    '
    ' Finally... return the SOUNDEX code
    '
    FnSoundexCode = UCase(Mid(SurnameToCode, 1, 1)) +
Mid(PlaceMarkersRemoved, 1, 3)

End Function

==========================================
"betsy Calcoen" <betsy.calcoen@skynet.be> wrote in message
news:3c209c3d$0$10318$ba620e4c@news.skynet.be...
> hallo
>
> ik heb een zoekformulier gemaakt waarin een tekstveld staat : daar geven
> gebruikers de naam in
> Bij het klikken op een opdracht knop wordt een query gestart waarmee
records
> worden opgezocht op basis van wat in het tekstveld staat ingevuld en
worden
> deze recordgegevens in een lijstbox geplaatst:
>
> een probleem
> als de gebruiker bv. "federation" intypt, dan krijgt hij de franstalige
> 'f�d�rations' niet te zien
> kent iemand een oplossing om ervoor te zorgen dat bij het intypen van
> "federation" toch ook  records met de naam 'f�d�rations" te voorschijn
komen
> in mijn lijstbox
>
>
> bedankt op voorhand
> Betsy
>
> Betsy.calcoen@skynet.be
>
>