Discussion :

[nouveauvba]

Bonsoir tous.
J'ai besoin d'un coup de pouce.
Je suis en train de travailler sur deux tableaux de plus de 5 000 lignes chacun afin de voir les concordances et discordances de chacun.
J'ai des éléments communs comme les départements, le nom des communes et parfois une date.
J'ai utilisé un vieux code que j'avais développé qui m'a déjà permis de bien dégrossir le travail en m'indiquant les éléments strictement identiques sur ces trois critères.
Mais, il suffit que la date soit différente pour que je ne corrèle pas et il peut y avoir plusieurs éléments dans le même département la même commune mais avec critère différent.
Je souhaite donc encore améliorer cette analyse en faisait une analyse par critère qui est une chaine de caractère et non rédigée de la même manière.
Pour cela j'ai trouvé une fonction de Jacques Boigontier qui à chaque fois me laisse sur ce qui sert à m'assoir et que je remercie au passage.

J'essaie modestement et à mon niveau d’intégrer et '"enrichir" son code en supprimant la corrélation si les mots ont moins de 3 lettres.

Le code présenté ci-dessous a pour objectif de déterminer le Range du premier département dans le tableau A et le Range de ce même département dans le tableau B. De lancer la fonction de M. Boisgontier et d'écrire le résultat dans mon tableau Excel (version 2003 )
Mais je n'arrive pas à écrire le résultat de la fonction dans la cellule correspondante. D'ailleurs dans la fonction ma variable résultat prend bien une valeur, mais quand je retourne dans le sub la variable reste désespérément vide. Je suis sûr que c'est un truc à la c..
Ps je sais que mon code n'est pas beau, je l’améliorai après et je fais ce que je peux avec mes très petites connaissances.
Voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
95
96
97
98
99
100
101
102
103
 
 
Public cata
Private resultat
 
Sub analyse() 
Dim resultat As String
a = 2
li = 0
b = 2
ce = 0
Do Until Cells(a, 1) = 10000
Do While Cells(b + ce, 9) = Cells(b, 9)
ce = ce + 1
Loop
cata = Range("j" & b & ":j" & b + ce)
Do While Cells(a + li, 1) = Cells(a, 1)
DemClient = Cells(a + li, 2)
Call Proche(DemClient, Range("j" & b & ":j" & b + ce))
Cells(a + li, 5) = resultat ' reste vide après le passage de la fonction
li = li + 1
Loop
 
a = a + li
b = b + ce
li = 0
ce = 0
Loop
End Sub
 
Function Proche(DemClient, cata As Range)
Dim strLen As Integer
Dim resultat As String
Set dMotsCat = CreateObject("Scripting.Dictionary")
Set dref = CreateObject("Scripting.Dictionary")
I = 1
For Each c In cata
dref(CStr(I)) = c.Value
For Each m In Split(Trim(c.Value), " ")
strLen = Len(m)
If strLen >= 3 Then
dMotsCat(sansAccent(LCase(m))) = dMotsCat(sansAccent(LCase(m))) & CStr(I) & " "
End If
Next m
I = I + 1
Next c
DemClient = sansAccent(SansPoint(LCase(DemClient)))
Set dDemClient = CreateObject("Scripting.Dictionary")
For Each m In Split(DemClient, " ")
tem = False
For Each I In dMotsCat.keys
toto = Len(m)
If toto >= 3 Then
If I Like m & "*" Then
tem = True
Exit For
End If
End If
Next I
If tem Then
For Each ref In Split(Trim(dMotsCat(I)), " ")
dDemClient(ref) = dDemClient(ref) + 1
Next ref
End If
Next m
'-- recherche maxi dans dDemClient
If dDemClient.Count > 0 Then
Maxi = Application.Max(dDemClient.items)
MeilNotePourc = 0
For Each ref In dDemClient.keys
If dDemClient(ref) = Maxi Then
notePourc = Maxi / (UBound(Split(dref(ref), " ")) + 1)
If notePourc > MeilNotePourc Then
MeilNotePourc = notePourc
RefMeilNote = ref
meilNote = Maxi & "/" & (UBound(Split(Trim(dref(ref)), " ")) + 1)
End If
End If
Next ref
Proche = dref(RefMeilNote) & " [" & meilNote & "]"
resultat = Proche 'résultat à bien une valeur string qui ne remonte pas
Else
Proche = ""
resultat = Proche
End If
End Function
Function SansPoint(chaine)
a = Split(chaine, " ")
For I = LBound(a) To UBound(a)
If Right(a(I), 1) = "." Then a(I) = Left(a(I), Len(a(I)) - 1)
Next I
SansPoint = Join(a, " ")
End Function
Function sansAccent(chaine)
codeA = "ÉÈÊËÔéèêëàçùôûïî"
codeB = "EEEEOeeeeacuouii"
temp = chaine
For I = 1 To Len(temp)
p = InStr(codeA, Mid(temp, I, 1))
If p > 0 Then Mid(temp, I, 1) = Mid(codeB, p, 1)
Next
sansAccent = temp
End Function

Merci par avance de votre aide précieuse.
Bien cordialement
Nouveauvba

[eriiic]

Bonjour,

quand tu appelles une fonction il faut l'affecter à une variable :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

a= Proche(DemClient, Range("j" & b & ":j" & b + ce))

Et ta fonction retourne la valeur affectée à la variable portant le nom de la fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
   Proche= "xxx" ' valeur retournée
End function

rajouter Résultat= xxx ne sert à rien.
eric

[nouveauvba]

Bonjour Eriic et le forum.
Merci pour ton retour. Je teste cela probablement demain et reposterai pour donner le résultat (voir une autre question ).
Mais, je ne doute pas une seconde, vu ta réponse assez explicative, de la qualité de celle-ci.

Cordialement
Nouveauvba

[pijaku]

Bonjour,

En complément de la réponse d'Eric (que je salue au passage), rien ne te choque dans ton code?

Je vais en enlever les 4/5èmes, regarde :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private resultat  ' 1ère fois
 
Sub analyse() 
Dim resultat As String 'seconde fois
'ici du code 
Call Proche(DemClient, Range("j" & b & ":j" & b + ce))
Cells(a + li, 5) = resultat ' reste vide après le passage de la fonction
'encore du code
End Sub
 
Function Proche(DemClient, cata As Range)
Dim strLen As Integer
Dim resultat As String   'ah tiens!!! une troisième !
'du code
Proche = dref(RefMeilNote) & " [" & meilNote & "]"
resultat = Proche 'résultat à bien une valeur string qui ne remonte pas
'en fait Sissi, elle remonte,
'mais dans ta Sub analyse, il y a déjà une variable resultat
'qui elle n'est pas alimentée.....
'Moralité :
'Trop de résultat tue le résultat..................................
'et du code
End Function