Macro _Database trouver une partie texte, copier dans une autre cellule et remplacer

Version imprimable

21/12/2022, 05h04
Maxime VANDEPLASSCHE

1 pièce(s) jointe(s)

Macro _Database trouver une partie texte, copier dans une autre cellule et remplacer

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

1 pièce(s) jointe(s)

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.

Pièce jointe 631137

Code:

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

21/12/2022, 10h30
Invité

Bonjour Maxime

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

Comme quoi...
21/12/2022, 16h01
Maxime VANDEPLASSCHE

1 pièce(s) jointe(s)

Merci beaucoup!!!

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

Pièce jointe 631169
30/12/2022, 06h28
ARTURO83

1 pièce(s) jointe(s)

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".

Pièce jointe 631629

Cdlt

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:

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).