zebanx
XLDnaute Accro
Bonjour à tous,
Cette demande fait suite à la remarquable réponse apportée en VBA sur ce fil par DRANREB (merci ) par l'intermédiaire d'une fonction (et jocelyn pour la formule à remercier aussi)
https://www.excel-downloads.com/threads/regroupement-selon-mots-clés.20026877
Réalisé sur ce fil : affectation d'un mot clé présent dans la cellule à une référence dans une BDD (goudron -> route...).
Souhait :
Si un libellé de facture repris en colonne "A" concerne plusieurs catégories potentiellement, il faudrait que la restitution fournisse l'ensemble des mots clés retrouvés (après, je me débrouille avec un split).
J'ai un peu modifié ce code en conséquence mais s'il y a redondance pour un mot clé, comment faire pour le supprimer svp ?
Vous en remerciant par avance,
xl-ment
zebanx
Cette demande fait suite à la remarquable réponse apportée en VBA sur ce fil par DRANREB (merci ) par l'intermédiaire d'une fonction (et jocelyn pour la formule à remercier aussi)
https://www.excel-downloads.com/threads/regroupement-selon-mots-clés.20026877
Réalisé sur ce fil : affectation d'un mot clé présent dans la cellule à une référence dans une BDD (goudron -> route...).
Souhait :
Si un libellé de facture repris en colonne "A" concerne plusieurs catégories potentiellement, il faudrait que la restitution fournisse l'ensemble des mots clés retrouvés (après, je me débrouille avec un split).
J'ai un peu modifié ce code en conséquence mais s'il y a redondance pour un mot clé, comment faire pour le supprimer svp ?
Vous en remerciant par avance,
xl-ment
zebanx
VB:
Function RECHMC2(ByVal Texte As String) As String
'code repris sur fonction de DRANREB
Dim Td(), L As Long, C As Long, Ts() As String, P As Long, tour%
Ts = Split(UCase(Texte))
tour = 1
If Dic Is Nothing Then
Set Dic = New Dictionary
Td = [G2:AA2].Resize([G1000].End(xlUp).Row - 1).Value
For L = 1 To UBound(Td, 1)
For C = 2 To UBound(Td, 2)
If IsEmpty(Td(L, C)) Then Exit For
Dic(UCase(Td(L, C))) = Td(L, 1)
Next C, L
End If
For P = 0 To UBound(Ts)
If Dic.Exists(Ts(P)) Then
If tour = 1 Then
RECHMC2 = Dic(Ts(P))
tour = tour + 1
Else
RECHMC2 = RECHMC2 & "-" & Dic(Ts(P))
End If
End If
Next P
End Function
Pièces jointes
Dernière édition: