Discussion :

[Maxime VANDEPLASSCHE]

Bonjour,

Je travaille sur une database avec enormement d'informations qui n'a jamais ete standardisee.
Dans un premier, je souhaiterais
1. rechercher une partie de texte dans les cellules d'une colonne (colonne b jusau'a derniere ligne) --> exemple: Find 'CTR'
2. Copier CTR dans la cellule d'a cote Colonne C
3. Remplacer CTR par CENTRALIZER en colonne D

Et recontinuer avec d'autres criteres

1. rechercher une partie de texte dans les cellules d'une colonne (colonne b jusqu'a derniere ligne) --> exemple: Find 'VLV'
2. Copier VLB dans la cellule d'a cote Colonne C
3. Remplacer VLV par VALVE en colonne D

etc.

Dans un second temps, et la ca risque d'etre beaucoup plus complique, je dois verifier que les abbreviations (exemple: CTR) correspond seulement a "Centralizer". Dans certains cas, CTR correspond a Control ou a autre chose. Et cela je dois le verifier a partir d'une autre colonne, mais cela ca risaue d'etre tres complique

Si quelqu'un peut m'aider a ce sujet ce serait genial.
MErci a tous

[ARTURO83]

Bonjour,

Pour rechercher un terme spécifique et mettre en colonne C, OK mais, remplacer ce même terme dans la colonne D, là je ne comprends pas, c'est sûr qu'il s'agit bien de la colonne D?
En attendant, voici un premier jet pour la recherche et la copie en colonne C.

Maxime VANDEPLASSCHE_VBA MACRO _ DATABASE TROUVER UNE PARTIE TEXTE, COPIER DANS UNE AUTRE CELLU.xlsm

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
Sub Copier_Remplacer()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim i As Long, j As Long, DerLig_f1 As Long, DerLig_f2 As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Sheet1")
    Set f2 = Sheets("Sheet2")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To DerLig_f2
        Cherche = f2.Cells(i, "A")
        Remplace = f2.Cells(i, "B")
        With f1.Range("B1:B" & DerLig_f1)
            Set x = .Find(Cherche, lookat:=xlPart)
            If Not x Is Nothing Then
            Pos = x.Address
            Do
                f1.Cells(x.Row, "C") = Cherche
                'f1.Cells(x.Row, "D") = Remplace 'en attente de précisions
                Set x = .FindNext(x)
            Loop While x.Address <> Pos And Not x Is Nothing
            End If
        End With
    Next i
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

[Invité]

Bonjour Maxime

Pour un "ingénieur qualité méthodes" bravo pour le HURLEMENT du TITRE TOUT EN MAJUSCULE 😱

Comme quoi...

[Maxime VANDEPLASSCHE]

Bonjour ARTURO83

Un grand merci pour cette aide précieuse.
Effectivement, la colonne D est déja remplie. J'ai inséré une colonne vide pour y insérer le code si cela vous est possible.
Et sachant que cette database est une extraction brute et que certaines abbréviations ne correspondent pas toujours au mot défini dans le code, est ce réalisable d'effectuer une recherche des champs de la ligne et de sélectionner le mot commençant par cette abbréviation?

Exemple
Ligne 4:
1. La macro recherche "COND" en colonne A et l'insère en colonne C
2. La macro recherche dans les lignes (exemple ligne 4 et trouve CONDUCTOR (Range J4)
3. La macro Remplace le "COND" par CONDUCTOR

Ligne 281
1. La macro recherche "COND" en colonne A et l'insère en colonne C
2. La macro recherche dans les lignes (exemple ligne 281 et trouve CONDENSER (Range J281)
3. La macro Remplace le "COND" par CONDENSER

Cela serait d'une grande aide pour commencer à standardiser la database
En tout cas, mille mercis pour ce code

MM Data-macro-v1.xlsm

[ARTURO83]

Bonjour,

Excusez-moi pour la réponse tardive, mais je n'ai pas été alerté par mail pour votre réponse.

Voici le fichier, complétez éventuellement la liste des termes à remplacer dans la feuille "liste".

Maxime VANDEPLASSCHE_VBA MACRO _ DATABASE TROUVER UNE PARTIE TEXTE, COPIER DANS UNE AUTRE CELLU.xlsm

Cdlt

[deedolith]

Salut,

Le nom de ta macro doit refléter ce qu'elle fait, en l'occurrence elle fait des recherche pour remplacer des valeurs.
RechercherRemplacer ou FindAndReplace est plus cohérent que Copier_Remplacer.

Ensuite, prend l'habitude d'utiliser la directive Option Explicit en début de chaque module (tu peux configurer l'IDE pour cela), la discipline n'a jamais tué personne et rendra plus de services que tu le penses.

Ta fonction viole le SRP. Plus d'infos ici: https://en.wikipedia.org/wiki/Single...lity_principle

C'est quoi ce réflexe de désactiver la mise à jour de l'écran (Application.ScreenUpdating) ?
- Quand on touche un paramètre applicatif, on le rétablis quand on en plus besoin.
- On ne l'altère que pour le minimum de temps possible.

Enfin, il y a plus simple, en tirant avantage du comportement des dictionnaires:

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
33
34
35
36
37
38
39
40
41
42
43
Option Explicit
 
Public Sub FindAndReplace()
    Dim Correspondances As Object    '// Scripting.Dictionary
    Set Correspondances = GetCorrespondances
 
    Dim Ws As Excel.Worksheet
    Set Ws = ThisWorkbook.Worksheets("sheet1")
 
    Dim LastRow As Long
    LastRow = Ws.Range("B:B").End(xlDown).Row
 
    Dim Rng As Excel.Range
    Set Rng = Ws.Range("B2:D" & LastRow)
 
    Dim Row As Excel.Range
    For Each Row In Rng.Rows
        Dim Key As Variant
        For Each Key In Correspondances.Keys
            If (InStr(Row.Cells(1).Value, Key) > 0) Then
                Row.Cells(2).Value = Key
                Row.Cells(3).Value = Correspondances(Key)
            End If
        Next
    Next
End Sub
 
Private Function GetCorrespondances() As Object    '// Scripting.Dictionary
    Dim Correspondances As Object    '// Scripting.Dictionary
    Set Correspondances = CreateObject("Scripting.Dictionary")
 
    Dim Ws As Excel.Worksheet
    Set Ws = ThisWorkbook.Worksheets("Liste")
 
    Dim LastRow As Long
    LastRow = Ws.Range("A:A").End(xlDown).Row
 
    Dim i As Long
    For i = 2 To LastRow
        Correspondances.Add Key:=Ws.Cells(i, 1).Value, Item:=Ws.Cells(i, 2).Value
    Next
    Set GetCorrespondances = Correspondances
End Function

Note:
Des tableaux structurés auraient été bienvenu (plus facile à manipuler).