Discussion :

[Invité]

Bonjour,

j'ai vraiment besoin d'aide SVP

je souhaite réaliser une application excel sur la base de formule ou en VBA
qui me permettrait d'attribuer un code à une colonne d'un tableau sur la base de mots clés enregistré dans un autre tableau.
Une recherche des mots clé dans une colonne "LIBELLE" devra être réalisé puis chaque fois qu'un mot clé est trouvé dans le libellé, le code correspondant à la ligne des mots clé sera attribué dans une colonne en face du libellé contenant le mot clé...

Etant loin d'être bon en formule et encore moins en VBA, j'ai bien essayé pendant plusieurs jours de trouver la solution pour me rendre finalement compte que j'étais très limité.

Je joins ce fichier excel dénommé "test" pour que vous ayez une meilleure idée du problème.

je vous remercie d'avance pour votre aide.

test.xlsx

[Thautheme]

Bonjour TBenzino, bonjour le forum,

Essaie comme ça :

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
Sub Macro1()
Dim K As Worksheet 'déclare la variable K (onglet)
Dim T As Worksheet 'déclare la variable T (onglet)
Dim TBK As Variant 'déclare la variable TBK (TaBleau de K)
Dim TBT As Variant 'déclare la variable TBT (TaBleu de B)
Dim TC() As Variant 'déclare la variable TC (Tableau des Codes)
 
Set K = Worksheets("KEYWORD") 'définit l'onglet K
Set T = Worksheets("TABLEAU") 'définit l'onglet T
T.Columns(4).ClearContents 'efface d'éventuelles anciennes données
TBK = K.Range("B2").CurrentRegion 'définit le tableau TBK de l'onglet K
TBT = T.Range("C3").CurrentRegion 'définit le tableau TBT de l'onglet T
ReDim TC(UBound(TBT, 1) - 1) 'redimensionne le tableau des codes TV
For I = 2 To UBound(TBT, 1) 'boucle 1 : sur toutes les lignes I du tableau TBT (en partant de la seconde)
    For J = 2 To UBound(TBK, 1) 'boucle 2 : sur toutes les lignes J du tableau TBK (en partant de la seconde)
        For L = 2 To UBound(TBK, 2) 'boucle 2 : sur toutes les colonnes L du tableau TBK (en partant de la seconde)
            Debug.Print TBT(I, 1), TBK(J, L)
            If InStr(1, TBT(I, 1), TBK(J, L), vbTextCompare) <> 0 _
               And TBK(J, L) <> "" Then 'condition : si le texte du code (ligne J colonne L) est contenu dans le libellé (ligne I colonne 1) et le Keyword n'est pas vide
                TC(I - 2) = TBK(J, 1) 'recupère le code (ligne J, colonne 1 de TBK)
                GoTo suite 'va à l'étiquette "suite"
            End If 'fin de la condition
        Next L 'prochaine colonne de la boucle 3
    Next J 'prochaine ligne de la boucle 2
suite: 'étiquette
    Debug.Print TC(I - 2), I - 2
Next I 'prochaine ligne de la boucle 1
T.Range("D4").Resize(UBound(TC, 1)).Value = Application.Transpose(TC) 'renvoie dans D4 de l'onglet T le tableau TC transposé
End Sub

[Invité]

Bonsoir Thautheme,

Je te remercie pour ton aide. Ton programme marche bien seulement je constate que lorsque je veux distinguer les frais il y a une petite anomalie au niveau de l'affectation des codes.
Je te joint le fichier pour une meilleur compréhension. J'ai en effet modifié les mots clés...

test - Copie.xlsm

[Thautheme]

Re,

Oui en effet, si la ligne contient plusieurs mots-clé, le code ne prend en compte que le premier rencontré. Que voudrais-tu, qu'il affiche le dernier ? Tous les codes ?... Le code modifié pour lister tous les codes :

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
Sub Macro1()
Dim K As Worksheet 'déclare la variable K (onglet)
Dim T As Worksheet 'déclare la variable T (onglet)
Dim TBK As Variant 'déclare la variable TBK (TaBleau de K)
Dim TBT As Variant 'déclare la variable TBT (TaBleu de B)
Dim TC() As Variant 'déclare la variable TC (Tableau des Codes)
 
Set K = Worksheets("KEYWORD") 'définit l'onglet K
Set T = Worksheets("TABLEAU") 'définit l'onglet T
T.Columns(4).ClearContents 'efface d'éventuelles anciennes données
TBK = K.Range("B2").CurrentRegion 'définit le tableau TBK de l'onglet K
TBT = T.Range("C3").CurrentRegion 'définit le tableau TBT de l'onglet T
ReDim TC(UBound(TBT, 1) - 1) 'redimensionne le tableau des codes TV
For I = 2 To UBound(TBT, 1) 'boucle 1 : sur toutes les lignes I du tableau TBT (en partant de la seconde)
    For J = 2 To UBound(TBK, 1) 'boucle 2 : sur toutes les lignes J du tableau TBK (en partant de la seconde)
        For L = 2 To UBound(TBK, 2) 'boucle 2 : sur toutes les colonnes L du tableau TBK (en partant de la seconde)
            'Debug.Print TBT(I, 1), TBK(J, L)
            If InStr(1, TBT(I, 1), TBK(J, L), vbTextCompare) <> 0 _
              And TBK(J, L) <> "" Then 'condition 1 : si le texte du code (ligne J colonne L) est contenu dans le libellé (ligne I colonne 1) et le Keyword n'est pas vide
                If TC(I - 2) <> "" Then 'condition 2 : si le code I-2 n'est pas vide
                    'si le code existe déja dans la liste des code, va à l'étiquette "la"
                    If InStr(1, TC(I - 2), TBK(J, 1), vbTextCompare) <> 0 Then GoTo la
                End If 'fin de la condition 2
                TC(I - 2) = IIf(TC(I - 2) = "", TBK(J, 1), TC(I - 2) & ", " & TBK(J, 1)) 'recupère ou ajoute le code (ligne J, colonne 1 de TBK)
la: 'étiquette
            End If 'fin de la condition
        Next L 'prochaine colonne de la boucle 3
    Next J 'prochaine ligne de la boucle 2
    'Debug.Print TC(I - 2), I - 2
Next I 'prochaine ligne de la boucle 1
T.Range("D4").Resize(UBound(TC, 1)).Value = Application.Transpose(TC) 'renvoie dans D4 de l'onglet T le tableau TC transposé
End Sub

[Invité]

Bonjour THAUTHEME,

En fait je travaille sur des milliers de libellés et souvent je suis obligé de combiner des mots. par exemple "Frais de forçage" et "frais de tenue de compte" sont deux opérations différentes avec des codes différents...

Donc le programme devrait pouvoir distinguer le "frais" de "forçage" du "frais" de "tenue de compte". Ou de "l'effet" "avalisé" de "l'effet" "remis à l'escompte" et ainsi de suite...

Je joint un fichier avec plus d'opérations et de mots clés pour que tu puisse mieux appréhender la problématique.

Merci beaucoup pour ton aide.

test - Doublons .xlsm

[Thautheme]

Re,

Heu... Moi je ne vais plus rien appréhender du tout... Désolé et bonne chance.

[Invité]

Re,

Heu... Moi je ne vais plus rien appréhender du tout... Désolé et bonne chance.

lol la réponse qui tue... Merci pour ton aide.

[Thautheme]

Re,

Moi ce qui me tue ce sont les gens incapables d'exprimer leur problème correctement et qui, à chaque proposition, change la donne...

[Invité]

Re,

Moi ce qui me tue ce sont les gens incapables d'exprimer leur problème correctement et qui, à chaque proposition, change la donne...

Franchement si l'invective était une solution à mon problème je crois qu'il serait réglé...

Je crois avoir décris clairement ce que je souhaitais et l'ajout du fichier avec de nouvelles données était uniquement dans le but de mettre en exergue la problématique pas de "changer la donne". Maintenant si le problème tel que je l'ai posé ne t'amène pas forcément à le comprendre, l'attitude empreinte de sagesse aurait été de m'exprimer clairement ton incompréhension et je t'aurais apporté des éclaircissements. Mon but dans ce post était une demande d'aide mais la demande d'aide ne suppose en aucun cas un manque de respect à mon égard, je n'en ai pas besoin. Pour finir je ne souhaite pas en faire un débat éternel je préfère m'arrêter là...

Par ailleurs ayant suffisamment de hauteur pour essayer de te comprendre je tiens tout de même à te dire que je comprend que tu ne veuilles pas forcément chercher à cerner le problème mais que tu veuilles qu'il soit facilement accessible. Seulement toutes les problématiques ne le sont pas... Et comme affirmé tout à l'heure je te dis merci pour ton aide et je le pense sincèrement en plus puisque tu as pris le temps de réfléchir à mon problème et même si tu n'es pas allé jusqu'au bout je ne peux pas t'en vouloir d'autant plus que tu m'as fourni un exemple de code qui pourrais me conduire à la solution...

Je te prierais par contre de retenir ceci pour tes prochains échanges avec d'autres personnes : Savoir parler aux gens n'est pas signe de faiblesse mais le résultat d'une bonne éducation.

Sur ce, je préfère te prévenir que je ne répondrai à aucun de tes messages s'ils sont irrespectueux car j'ai franchement d'autres choses à penser et à faire aussi...

Merci et bonne continuation.