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 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+
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+
Merci à tous les deux !
Les 2 fonctionnent parfaitement