[vb6]soundex

Version imprimable

09/10/2003, 16h11
NESTLE

[vb6]soundex

Bonjour
Existe t'il un équivalent ACCESS (VB) à SOUNDEX ?
Merci
09/10/2003, 16h13
grafikm_fr

Je m'excuse pour ma connerie naturelle (je ne suis qu'un Protoss Reaver tout con), mais c'est quoi SOUNDEX???
09/10/2003, 16h15
NESTLE

Ca permet de comparer deux chaines de caractére approximative
EX : "Smith" et "Smythe" seront egale si on utilise soundex (en SQL server)
09/10/2003, 16h18
grafikm_fr

Ah OK...

Voila:

Citation:

The soundex algorithm:
The soundex code consists of the first letter of the surname, followed by three digits. The digits are based on the consonants as in the following table:

1) B,P,F,V
2) C,S,K,G,J,Q,X,Z
3) D,T
4) L
5) M,N
6) R

The vowels are not used. If two or more adjacent (not separated by a vowel) letters have the same numeric value, only one is used. This also applies if the first (which is used for the letter in the code), and the second letter in name have the same value; the second letter would not be used to generate a digit. If there are not three digits after the consonants are convert, the code is filled out with zeros. The name Lee has no consonants after the L, so the soundex code would be L000.

A partir de là, y a moyen de bricoler qqch...
Je vais voir ca de suite... :mrgreen:

Le code SOUNDEX... tada!..

Avertissment:
Il s'agit là de code bourrin dans la pure tradition de grafikm_fr...

[edité] Attention, il y avait un bug dans le code il est signalé par un commentaire erratum [edité]

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Option Explicit
 
 
Private Sub Command1_Click()
'calcul de SOUNDEX
Dim nom As String
Dim soundex As String
Dim buf As String * 1
Dim numcode As String * 1
Dim i As Long
Dim j As Long
nom = Text1.Text
nom = UCase(nom)
'il serait bien de mettre ici du code replacant
'les accents et les trucs comme ca, c'est interdit
'dans SOUNDEX. On se tape des voyelle, par contre
'les trucs comme "ç" faut faire gaffe...
soundex = Left(nom, 1)
For i = 2 To Len(nom)
buf = Mid(nom, i, 1)
Select Case buf
    Case "B": numcode = "1"
    Case "P": numcode = "1"
    Case "F": numcode = "1"
    Case "V": numcode = "1"
    Case "C": numcode = "2"
    Case "S": numcode = "2"
    Case "K": numcode = "2"
    Case "G": numcode = "2"
    Case "J": numcode = "2"
    Case "Q": numcode = "2"
    Case "X": numcode = "2"
    Case "Z": numcode = "2"
    Case "D": numcode = "3"
    Case "T": numcode = "3"
    Case "L": numcode = "4"
    Case "M": numcode = "5"
    Case "N": numcode = "5"
    Case "R": numcode = "6"
    Case Else: numcode = ""
End Select
soundex = soundex & numcode
Next i
 
    For j = 1 To 6
'ERRATUM CODE EDITE ICI *****************
        soundex = Replace(soundex, Trim(Str$(j)) & Trim(Str$(j)), Str$(j))
        soundex = Replace(soundex, Trim(Str$(j)) & Trim(Str$(j)), Str$(j))
    Next j
 
'on vire les eventuels espaces dus à la conversion...
soundex = Replace(soundex, " ", "")
'si la chaine est longue de plus de 4 (lettre+3 chiffres),
'on tronque
If Len(soundex) >= 5 Then soundex = Left(soundex, 4)
 
'si la chaine est trop courte, on rajoute des "0" pour complter
Select Case Len(soundex)
    Case 1: soundex = soundex & "000"
    Case 2: soundex = soundex & "00"
    Case 3: soundex = soundex & "0"
End Select
Text2.Text = soundex
End Sub

Testons donc ca avec les noms de nos modos... :mouarf:

rabilloud -> R143
AIM -> A500
puyfoulhoux -> P142

Testons aussi avec un nom à coucher dehors...
konieczny -> K525

Le code a été verifié en comparant les résultat à cette page:
http://www.geocities.com/heartland/hills/3916/soundex.html

10/10/2003, 09h41
NESTLE

Merci beaucoup
A charge de revanche
10/10/2003, 13h18
grafikm_fr

N'oublie pas de mettre le tag [Résolu] stp...
10/10/2003, 16h29
ThierryAIM

Chapeau bas, grafik :hola:

(Bon, tu aurais pu simplifier le 1er Case, mais c'est pour chipoter :mrgreen: )
11/10/2003, 20h02
grafikm_fr

Merci, mais j'ai rien fait d'extraordinaire :oops: