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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
| Option Compare Database
'Fonction qui split mon champ , qui va permettre de comparer mots identiques dans expression
Function correspondance(strchaine1 As String, strchaine2 As String)
Dim s1() As String, s2() As String
Dim i As Integer
s1 = Split(strchaine1): s2 = Split(strchaine2)
For i = 0 To UBound(s1)
For j = 0 To UBound(s2)
'j'enlève les mots non significatifs "de", "le" etc....
If Len(s1(i)) > 2 And Len(s2(j)) > 2 And _
s1(i) = s2(j) Then correspondance = correspondance + 1
Next j
Next i
End Function
Public Sub CommandeBV_Click()
Dim MaBd As Database
Dim MyRst As Recordset
Dim DptOk As String
Dim Nb_Enr As Long, x As Long
Dim Valeur As String, CurEnrg1 As Variant, CurEnrg2 As Variant, LIBAD As String, DP As String, Valvil As String, Str As String, VAL As Integer
Set MaBd = CurrentDb
Set tb = MaBd.TableDefs!sd
Set fi = tb.CreateField("Flag1", dbLong)
Set fi = tb.CreateField("Flag", dbText)
Set fi = tb.CreateField("Flag3", dbLong)
With tb
.Fields.Append .CreateField("Flag1", dbLong)
.Fields.Append .CreateField("Flag", dbText)
.Fields.Append .CreateField("Flag3", dbLong)
End With
Set MyRst = MaBd.OpenRecordset("sd", dbOpenDynaset)
If MyRst.Bookmarkable Then
MyRst.MoveLast
Nb_Enr = MyRst.RecordCount
MyRst.MoveFirst
For x = 1 To Nb_Enr - 1
CurEnrg1 = MyRst.Bookmark
If Not IsNull(MyRst!rs) Then
Valeur = MyRst!rs
End If
' LIBADR : libellé adresse
If Not IsNull(MyRst!LIBADR) Then
LIBAD = Right(MyRst!LIBADR, 8)
End If
'ACHEM : Localité
If Not IsNull(MyRst!ACHEM) Then
Valvil = Left(MyRst!ACHEM, 5)
End If
' CDPO : Codepostal
If Not IsNull(MyRst!CDPOS) Then
DP = Left(MyRst!CDPOS, 3)
End If
MyRst.MoveNext
'Je rentre dans la boucle je vérifie si au moins 1 mot commun entre les expression ou raison sociale (rs) identique,une partie de l'adresse identique
' les 3 premiers caractères code postal identique
Do
If ((correspondance(MyRst!rs, Valeur) >= 1) Or MyRst!rs = Valeur) And DP = Left(MyRst!CDPOS, 3) And LIBAD = Right(MyRst!LIBADR, 8) And Valvil = Left(MyRst!ACHEM, 5) Then
If IsNull(MyRst!flag1) Then
CurEnrg2 = MyRst.Bookmark
MyRst.Edit
'Je mets un numéro qui identifie le doublon
MyRst!flag1 = x
'Je flague correspondance Raison sociale
MyRst!Flag3 = correspondance(MyRst!rs, Valeur)
' Je flague le premier de groupe
MyRst!Flag = "N"
MyRst.Update
MyRst.Bookmark = CurEnrg1
MyRst.Edit
'Je remets le numéro qui identifie le doublon
MyRst!flag1 = x
MyRst.Update
MyRst.Bookmark = CurEnrg2
End If
End If
MyRst.MoveNext
Loop Until MyRst.EOF
MyRst.MoveFirst
MyRst.Move x
Next x
MyRst.Close
End If
End Sub |
