'1) éliminer les blancs à droite et à gauche du nom
mot = Trim(mot)

'2) Mise en majuscules non accentuées
mot = Replace(mot, "ç", "c")
mot = Replace(mot, "é", "e")
mot = Replace(mot, "è", "e")
mot = Replace(mot, "ê", "e")
mot = Replace(mot, "ë", "e")
mot = Replace(mot, "à", "a")
mot = Replace(mot, "û", "u")
mot = Replace(mot, "ü", "u")
mot = Replace(mot, "ù", "u")
mot = Replace(mot, "ï", "i")
mot = Replace(mot, "î", "i")
mot = Replace(mot, "ô", "o")
mot = Replace(mot, "ö", "p")
mot = UCase(mot)

'3) Eliminer les blancs et les tirets
mot = Replace(mot, " ", "")
mot = Replace(mot, "-", "")

'4) Remplacer certains groupes de lettres (selon le tableau fourni)
' en respectant l'ordre

mot = Replace(mot, "GUI", "KI")
mot = Replace(mot, "GUE", "KE")
mot = Replace(mot, "GA", "KA")
mot = Replace(mot, "GO", "KO")
mot = Replace(mot, "GU", "K")
mot = Replace(mot, "CA", "KA")
mot = Replace(mot, "CO", "KO")
mot = Replace(mot, "CU", "KU")
mot = Replace(mot, "Q", "K")
mot = Replace(mot, "CC", "K")
mot = Replace(mot, "CK", "K")

'5) Remplacer toutes les voyelles sauf le Y par A,
'excepté s'il y a un A à l'initial

If Left(mot, 1) <> "A" Then
mot = Replace(mot, "E", "A")
mot = Replace(mot, "I", "A")
mot = Replace(mot, "O", "A")
mot = Replace(mot, "U", "A")
End If

'6) Remplacer les préfixes par leur correspondance (selon le tableau fourni)
' note personnelle : cela convient sans doute aux bases de données contenant
' des prénoms, mais je me pose la question de la pertinence de cette étape
' pour la correction orthographique
mot = Replace(mot, "MAC", "MCC")
mot = Replace(mot, "ASA", "AZA") 'comme Asamian
mot = Replace(mot, "KN", "NN") 'comme Knight
mot = Replace(mot, "PF", "FF") 'comme Pfeiffer
mot = Replace(mot, "SCH", "SSS") 'comme Schindler
mot = Replace(mot, "PH", "FF") 'comme Philippe

'7) Supprimer les H sauf s'ils sont précédés par C ou S
If Left(mot, 1) = "H" Then mot = Mid(mot, 2, Len(mot)) 'suppression du H initial
' qui ne peut pas être précédé par C ou S...
For n = 1 To Len(mot)
On Error Resume Next
car = Mid(mot, n, 1)
If Mid(mot, n - 1, 1) <> "C" And _
Mid(mot, n - 1, 1) <> "S" And _
car = "H" Then
mot = Mid(mot, 1, n - 1) & Mid(mot, n + 1, Len(mot))
End If
Next n

'8) Supprimer les Y sauf précédés de A
If Left(mot, 1) = "Y" Then mot = Mid(mot, 2, Len(mot)) 'suppression du Y initial
' qui ne peut pas être précédé par A...
For n = 1 To Len(mot)
On Error Resume Next
car = Mid(mot, n, 1)
If Mid(mot, n - 1, 1) <> "A" And _
car = "Y" Then
mot = Mid(mot, 1, n - 1) & Mid(mot, n + 1, Len(mot))
End If
Next n

'9)Supprimer les terminaisons suivantes: A, T, D, S

Select Case Right(mot, 1)
Case "A", "T", "D", "S"
mot = Left(mot, Len(mot) - 1)
End Select

'10)Enlever tous les A, sauf le A initial

If Left(mot, 1) <> "A" Then
mot = Replace(mot, "A", "")
Else
mot = "A" & Replace(mot, "A", "")
End If

'11) Enlever toutes les sous chaîanes répétitives

For n = 2 To Len(mot)
car = Mid(mot, n, 1) ' car = caractère en cours
If car = Mid(mot, n - 1, 1) Then 'si car est = au caractère précédent,i.e. doublon
mot = Mid(mot, 1, n - 1) & Mid(mot, n + 1, Len(mot)) 'on le supprime
End If
Next n

'12)Conserver les 4 premiers caractères du mot
'et si besoin le compléter par des blancs

If Len(mot) < 4 Then
mot = mot & Space(4 - Len(mot))
Else
mot = Left(mot, 4)
End If

SoundEX2 = mot

End Function