Correspondance approximative de mots dans une base de données

Bonjour à tous,

Je travaille sur un reporting d'effectifs. J'ai 7 colonnes et environ 7000 lignes dans mon tableau. Chaque colonne me donne un peu plus de détails sur la fonction qu'exerce l'employé.

Par exemple (1 employé étant 1 ligne), j'ai :

Colonne 1 : Groupe X

Colonne 2 : Direction finance groupe X

Colonne 3 : Direction finance et contrôle groupe X

Colonne 4 : Service trésorerie

Colonne 5 : Analyse financière tréso

etc...

Je voudrais pouvoir chercher, dans toute cette database, le mot "tréso", et ainsi créer une 6ème colonne appelée "Trésorerie" où tous les employés qui travaillent dessus seraient rassemblés. (Ce à quoi vous allez me répondre : "vous avez déjà l'information dans la colonne 4" - mais l'information est très mal organisée et selon le nombre de strates hiérarchiques, l'information peut être dans la colonne 4, 1, 2, 3 ou 5 donc ça le rend très difficile à retraiter)

Connaissez-vous une technique pour rechercher un bout de mot (donc correspondance approximative) dans 5 colonnes différentes, et qui pourrait me dire, pour chaque ligne, si oui ou non l'employé travaille sur la trésorerie ?

Je ne sais pas si je suis claire... Mais je serais ravie si l'un de vous pouvait m'aider !

Un grand merci par avance.

bonjour,

avec un filtre avancé

Bonjour le fil, bonjour le forum,

Une proposition VBA avec le code ci-dessous :

Sub Macro1()
Dim BR As Variant 'déclare la variable BR (Boîte de Recherche)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

BR = Application.InputBox("Tapez le texte recherché.", "RECHERHCE", Type:=2) 'définit la boîte de recherche BR
If BR = False Or BR = "" Then Exit Sub 'si [Annuler] ou non renseignée, sort de la procédure
Set OS = Worksheets("Feuil1") 'définit l'onglet source OS (à adapter à ton cas)
TV = OS.Range("A1").CurrentRegion 'défini le tableau des valeurs TV
Set OD = Worksheets("Feuil2") 'défnit l'onglet destination OD (à adapter à ton cas)
OD.Cells.ClearContents 'efface le contenu de toutes les cellules de l'ojnglet OD
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    For J = 1 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
        If InStr(1, TV(I, J), BR) <> 0 Then 'condition : si le texte de la boîte de recherche BR est contenu dans la donnée ligne I colonne J de TV
            ReDim Preserve TL(1 To UBound(TV, 2), 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To UBound(TV, 2) 'boucle 3 : sur toutes les colonnes J du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=> Transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
If K > 1 Then 'condition : si K est supérieure à 1
    OD.Range("A1").Resize(1, UBound(TV, 2)).Value = Application.Index(TV, 1) 'renvoie la première ligne du tableau des valeurs dans la cellule A1 redimensionnée de l'onglet OD
    OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans la cellule A2 redimensionnée de l'onglet OD
End If 'fin de la condition
End Sub

Salut jeannotlapin,

Salut H2so4,

une autre solution avec VBA,

- un double-clic sur la feuille pour un premier traitement global ;

Sub Worksheet_BeforeDoubleClick

- ensuite, lors de chaque changement de valeur en colonnes [A:E] ;

Sub Worksheet_Change

Codes à coller dans le module VBA de la feuille à traiter.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab
'
Cancel = True
Application.EnableEvents = False
'
tTab = Range("A2").Resize(Range("A" & Rows.Count).End(xlUp).Row, 6).Value
For x = 1 To UBound(tTab, 1)
    For y = 1 To UBound(tTab, 2) - 1
        If InStr(UCase(tTab(x, y)), "TRESO") > 0 Or InStr(UCase(tTab(x, y)), "TRÉSO") > 0 Then tTab(x, 6) = "X"
    Next
Next
Range("A2").Resize(UBound(tTab, 1), 6).Value = tTab
'
Application.EnableEvents = True
'
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
'
If Not Intersect(Target, Range("A:E")) Is Nothing Then
    If InStr(UCase(Target), "TRESO") > 0 Or InStr(UCase(Target), "TRÉSO") > 0 Then Range("F" & Target.Row).Value = "X"
End If
'
Application.EnableEvents = True
'
End Sub

A+

bonjour,

avec un filtre avancé

Bonjour,

Merci beaucoup pour l'Excel mais je cherche un moyen plus automatisé de le faire afin de ne pas à le refaire tous les mois en recevant une nouvelle extraction !

5essai.xlsx (23.80 Ko)

Salut jeannotlapin,

Salut H2so4,

une autre solution avec VBA,

- un double-clic sur la feuille pour un premier traitement global ;

Sub Worksheet_BeforeDoubleClick

- ensuite, lors de chaque changement de valeur en colonnes [A:E] ;

Sub Worksheet_Change

Codes à coller dans le module VBA de la feuille à traiter.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab
'
Cancel = True
Application.EnableEvents = False
'
tTab = Range("A2").Resize(Range("A" & Rows.Count).End(xlUp).Row, 6).Value
For x = 1 To UBound(tTab, 1)
    For y = 1 To UBound(tTab, 2) - 1
        If InStr(UCase(tTab(x, y)), "TRESO") > 0 Or InStr(UCase(tTab(x, y)), "TRÉSO") > 0 Then tTab(x, 6) = "X"
    Next
Next
Range("A2").Resize(UBound(tTab, 1), 6).Value = tTab
'
Application.EnableEvents = True
'
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
'
If Not Intersect(Target, Range("A:E")) Is Nothing Then
    If InStr(UCase(Target), "TRESO") > 0 Or InStr(UCase(Target), "TRÉSO") > 0 Then Range("F" & Target.Row).Value = "X"
End If
'
Application.EnableEvents = True
'
End Sub

A+

Bonjour ThauTème et curulis57,

Merci beaucoup pour vos réponses ! Toutefois, je n'arrive pas à essayer vos VBA.

Pourriez-vous essayer de le faire dans l'Excel test ci-joint ?

Merci mille fois pour votre aide.

Re,

Mon code nécessitait deux onglets. Je l'ai placé (adapté et légèrement modifié) dans ton fichier test avec un bouton dans la première ligne de l'onglet Fonction finance monde. Clique sur le bouton, tape le mot recherché et valide...

Le fichier :

Salut jeannotlapin,

Salut H2so4, ThauTheme (que je n'avais pas vu... )

même principe mais les résultats sont en colonne [H:H]

A+

5jeannotlapin.xlsm (31.33 Ko)

Merci à tous les deux !

Les 2 fonctionnent parfaitement

Rechercher des sujets similaires à "correspondance approximative mots base donnees"