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.