Attribuer une catégorie en fonctions de mot clés

Hello à tous !!

Je cherche à attribuer une "catégorie" à des dépenses.

J'ai mis en feuil1 nommé "source" en ligne 20 à de B à M mes "catégories" ex : "B20 Logement ; C20 Transport etc..."

Sous chaque catégorie j'ai renseigné des "mots clés" ex : " B21 loyer ; B22 gaz ; B23 assurance habitation"

En feuil2 nommé "flux" colonne D se trouve les libellés qui peuvent (ou non) contenir un des mots clés de ma feuil1.

Vous l'aurez probablement devinez je cherche la macro qui me permet d'attribuer en colonne G "catégorie" la catégorie correspondante si un mot clé est trouvé...

J'ai besoin de vos lumières pour m'aider à atteindre ce but.

Voici mon code qui manifestement ne fonctionne pas malgré plusieurs tentative de modifications...

Merci d'avance aux contributeurs !

Sub CategorizeFlux()
    Dim sourceSheet As Worksheet
    Dim fluxSheet As Worksheet
    Dim lastRow As Long, sourceLastColumn As Long
    Dim i As Long, j As Long, k As Long
    Dim keyword As String
    Dim category As String
    Dim found As Boolean

    Set sourceSheet = ThisWorkbook.Worksheets("source")
    Set fluxSheet = ThisWorkbook.Worksheets("flux")
    lastRow = fluxSheet.Cells(fluxSheet.Rows.Count, "D").End(xlUp).Row
    sourceLastColumn = sourceSheet.Cells(20, sourceSheet.Columns.Count).End(xlToLeft).Column

    For i = 5 To lastRow ' Parcours des lignes de la feuille "flux"
        found = False ' Réinitialisation de la variable à chaque ligne de la boucle i
        For j = 2 To sourceLastColumn ' Colonnes B à la dernière colonne non vide de la feuille "source"
            For k = 21 To 100 ' Lignes 21 à 100 de la feuille "source"
                keyword = sourceSheet.Cells(k, j).Value
                If InStr(fluxSheet.Cells(i, 4).Value, keyword) > 0 Then
                    category = sourceSheet.Cells(20, j).Value ' Ligne 20
                    found = True ' Mot clé trouvé, on sort des boucles
                    Exit For
                End If
            Next k
            If found Then Exit For ' Mot clé trouvé, on sort de la boucle j
        Next j
        If found Then ' Catégorie trouvée, on l'ajoute à la colonne G
            fluxSheet.Cells(i, 7).Value = category
        End If
    Next i
End Sub

Bonjour,

Un fichier minimal illustrant votre situation ?

Pourquoi votre code ne fonctionne pas ? Quelle(s) erreur(s) rencontrez-vous ?

A vous lire

Biensur voici un tableau test vidé (juste le nécessaire pour faire des éssais)
Le tableau n'accepte peut être pas les macros (ce n'est pas le cas de mon tableau original).

Merci à vous

Bonjour,

Merci pour le fichier exemple.

Le problème était que vous récupériez des sous-catégories jusqu'aux lignes 100, c'est-à-dire, majoritairement des cellules vides.

Or pour la fonction InStr, le caractère nul "" est présent dans tous les chaines de caractères, ce qui vous sortait de la boucle sur les catégories.

Voici une proposition qui devrait éviter ce problème :

Sub CategorizeFlux_v2()

    Dim ws0 As Worksheet, ws1 As Worksheet
    Dim n As Long, m As Long, p As Long
    Dim i As Long, j As Long, k As Long

    Set ws0 = ThisWorkbook.Worksheets("source")
    Set ws1 = ThisWorkbook.Worksheets("flux")
    n = ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row
    m = ws0.Cells(20, ws0.Columns.Count).End(xlToLeft).Column

    For i = 5 To n
        For j = 2 To m
            If ws0.Cells(21, j) <> vbNullString Then 'S'il existe au moins une sous-catégorie
                p = ws0.Cells(20, j).End(xlDown).Row
                For k = 21 To p
                    If InStr(ws1.Cells(i, 4).Value, ws0.Cells(k, j).Value) > 0 Then
                        ws1.Cells(i, 7).Value = ws0.Cells(20, j).Value ' Attention, si plusieurs sous-catégories détectées, seule la dernière sera insérée
                    End If
                Next k
            End If
        Next j
    Next i

End Sub

Super c'est bien ça ! Merci pour l'explication ! Je passe le post en validé. Excellente journée !