Problème d'un rechercher/remplacer spécifique (!PC et MAC!)

**RyuAutodidacte** · 03/05/2015, 02h25

Bonsoir,
Pouvez vous m'aider sur le problème suivant (je tourne en rond, en rond…) : je cherche à faire un rechercher/remplacer/ajouter :

- J'ai une feuille1 avec des Réf. en col A et une feuille 2 aussi avec des Réf. tjs en col A; pour chacune des références sur les feuiles 1 et 2 j'ai des infos qui leurs corresponds qui vont de col B à H
Exemple : Feuil1 —> REF_A | INFO_1 | INFO_2 | INFO_3 | INFO_4 | INFO_5 | INFO_6 | INFO_7
Exemple : Feuil2 —> REF_A | INFO_8 | INFO_9 | INFO_7 | INFO_2 | INFO_6 | INFO_5 | INFO_1

- Mon code scan chaque ligne de la col A de la feuille 1 une à une pour retrouver la même Réf. en Feuil2 de la col A
- Si les réfs correspondent entre la feuil1 et la feuil2, je copie colle les infos de la feuil1 de A&i:H&i (i étant la ligne scanée) sur la feuil2 de A&Num_ligne:H&Num_ligne (Num_ligne étant le N° de ligne de la feuil2)
- Dans le cas où il n y a pas de réf correspondante entre la feuil1 et la feuil2 j'ai une erreur; dans ce cas la réf de la feuil1 est copié aprés la derniere réf de la feuil2 et ca la ou ca me pose problème

Pouvez vous m'aidez aussi a optimisé mon code svp.

PS : soyez indulgent ça fait qu'une semaine que je viens de commencer le vba et à intermittence.
Bref de blabla le code

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
44
45
46
47
Sub Remplace()
Dim i As Integer
 
Application.ScreenUpdating = False
 
DerNum_Ligne_A = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
Plage_A_Col = Worksheets(1).Range("A1:A" & DerNum_Ligne_A)
 
DerNum_Ligne_B = Worksheets(2).Range("A" & Rows.Count).End(xlUp).Row
Plage_B_Col = Worksheets(2).Range("A1:A" & DerNum_Ligne_B)
 
For i = 1 To DerNum_Ligne_A
 
      On Error GoTo ErrorHandler
 
      MaRef_A = Worksheets(1).Cells(i, 1).Value
 
      Num_Ligne = Application.Match(MaRef_A, Plage_B_Col, 0)
 
      MaRef_B = Worksheets(2).Cells(Num_Ligne, 1).Value
 
      Worksheets(1).Activate
      Set Plage_A = Range("A" & i & ":" & "H" & i)
      Plage_A.Select
      Selection.Copy
 
      Worksheets(2).Activate
      Set Plage_B = Range("A" & Num_Ligne & ":" & "H" & Num_Ligne)
      Plage_B.Select
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=False
 
      Exit Sub
 
      ErrorHandler:
 
      Worksheets(1).Range("A" & i & ":" & "H" & i).Select
      Selection.Copy
      Worksheets(2).Cells(Rows.Count, 1).End(xlUp)(2).Select
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=False
 
      Resume Next
 
 Next i
 
End Sub

le premier code que j'ai retourné dans tous les sens avant d'arriver a ce résultat

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
44
45
46
Sub Boucle()
Dim i As Integer
 
Application.ScreenUpdating = False
 
DernLigne1 = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
MaPlage1 = Worksheets(1).Range("A1:A" & DernLigne1)
 
DernLigne2 = Worksheets(2).Range("A" & Rows.Count).End(xlUp).Row
MaPlage2 = Worksheets(2).Range("A1:A" & DernLigne2)
 
For i = 1 To DernLigne1
      MaRef = Worksheets(1).Cells(i, 1).Value
 
      Ligne = Application.Match(MaRef, MaPlage2, 0)
 
      MsgBox Ligne, vbOKOnly, "Numéro de ligne"
 
      MaRef2 = Worksheets(2).Cells(Ligne, 1).Value
 
      If MaRef = MaRef2 Then
 
      Worksheets(1).Activate
      Set REFA = Range("A" & i & ":" & "H" & i)
      REFA.Select
      Selection.Copy
 
      Worksheets(2).Activate
      Set REFB = Range("A" & Ligne & ":" & "H" & Ligne)
      REFB.Select
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False
 
       Else
 
       Worksheets(1).Range("A" & i & ":" & "H" & i).Select
       Selection.Copy
       Worksheets(2).Cells(Rows.Count, 1).End(xlUp)(2).Select
       Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False
 
       End If
 
 Next i
 
End Sub

**Marc-L** · 03/05/2015, 02h26

Bonjour,

je n'ai pas cherché à corriger le code dépassant vingt lignes pour une simple copie !

Même si la logique est bonne, un code pur VBA est bien moins efficace (car interprété)
que celui conçu autour des fonctionnalités internes d'Excel (pré-compilées elles !) …

En respectant la règle TBTO, démonstration testée sur une version Windows
avec des données contigües (bloc sans ligne ni colonne vide) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Demo()
    Dim Rc As Range, Rw As Range
    Application.ScreenUpdating = False
 
    For Each Rw In Feuil1.Cells(1).CurrentRegion.Rows
        With Feuil2.Cells(1).CurrentRegion.Columns(1)
                Set Rc = .Find(Rw.Cells(1).Value)
                 If Rc Is Nothing Then Set Rc = .Cells(.Rows.Count).Offset(1)
            Rw.Copy Rc
        End With
    Next
 
    Set Rc = Nothing
End Sub

Un bon code n'utilise pas de Select ni d'Activate surtout au sein d'une boucle ! Sinon ralentissement …

_____________________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

_____________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo

Désolé, je n'avais pas vu l'utilisation de la fonction de feuille de calculs EQUIV et la copie des valeurs uniquement …

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
Sub Demo2()
    Dim Rw As Range
    Application.ScreenUpdating = False
 
    With Feuil2
        With .Cells(1).CurrentRegion
            C& = .Columns.Count
            R& = .Rows.Count
        End With
 
        For Each Rw In Feuil1.Cells(1).CurrentRegion.Rows
            V = Application.Match(Rw.Cells(1).Value, .Cells(1).Resize(R), 0)
            If IsError(V) Then R = R + 1: V = R
            .Cells(V, 1).Resize(, C).Value = Rw.Value
        Next
    End With
End Sub

La variable V est de type Variant afin de ne pas déclencher d'erreur …

_____________________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**RyuAutodidacte** · 03/05/2015, 03h48

Marc-L , il est incroyable ton code
dire que ca fait plusieur jours que je me retourne le pbm
c'est vaiment efficace
j'ai loin d'avoir ton niveau
est il possible d'avoir des annotations pour mieux comprende ton code??
j'étais sur la bonne piste avec le On Error… ??

en tout cas merci

il faut que je teste avec mon fichier principal car la feuille 1 les valeurs sont données par des formules excel

je crois que nos messages sont decalé lol

c'est pas grave en tout cas merci pour tes réponses rapide

Désolé, je n'avais pas vu l'utilisation de la fonction de feuille de calculs EQUIV et la copie des valeurs uniquement …

**Marc-L** · 03/05/2015, 03h52

Voir ma Demo2 : pas besoin d'instruction On Error avec une variable de type Variant …

Afin de comprendre, voici la méthode la plus efficace (qui me sert encore) :
positionner dans le code le curseur sur une instruction, appuyer sur la touche

puis consulter l'aide VBA !

Je te laisse donc faire l'effort de la rétro-analyse car c'est bien plus formateur …

Et ne pas oublier :
_____________________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

_____________________________________________________________________________________________________
L'effort fait les forts …

**RyuAutodidacte** · 03/05/2015, 12h34

C'est vrai tu as raison, c'est plus formateur
d'ailleurs c'est comme ca que j'ai fait mon code en analysant les codes, les définitions sur internet et aussi sur mes connaissances des formules sur exel
d'ou le choix de Equiv qui me parraissait bien plus judicieux quand je l'ai fait

Par contre j'aimerais bien savoir ou j'ai foiré avec le On error GoTo … je pensais l'avoir compris
mais je pense que j'étais pas loin du résultat (attention j'adopte entièrement ton code) mais j'aime bien aller au bout des choses et comprendre mes erreurs

Sinon c'est passé nickel sur mon fichier source

grand merci

Re, je n'ai pas encore réussi à comprendre mon erreur sur le "On error…" PS : je suis tjs preneur pour que l'on m'explique
Par contre j'ai corrigé ma 1ere version avec le : "If IsError" que j'ai vu dans le code de Marc-L; c'est sur l'écriture est loin d'être parfaite mais c'est comme ca que l'on apprend.

Mon code avec le "If …" :

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
44
45
46
Sub Boucle()
Dim i As Integer
 
Application.ScreenUpdating = False
 
DernLigne1 = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
MaPlage1 = Worksheets(1).Range("A1:A" & DernLigne1)
 
DernLigne2 = Worksheets(2).Range("A" & Rows.Count).End(xlUp).Row
MaPlage2 = Worksheets(2).Range("A1:A" & DernLigne2)
 
For i = 1 To DernLigne1
      MaRef = Worksheets(1).Cells(i, 1).Value
 
      Ligne = Application.Match(MaRef, MaPlage2, 0)
 
      If IsError(Ligne) Then
 
       Worksheets(1).Activate
       Set Copie = Range("A" & i & ":" & "H" & i)
       Copie.Select
       Selection.Copy
       Worksheets(2).Activate
       Set Range2 = Cells(Rows.Count, 1).End(xlUp)(2)
       Range2.Select
       Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False
 
       ElseIf MaRef = Worksheets(2).Cells(Ligne, 1).Value Then
 
      Worksheets(1).Activate
      Set REFA = Range("A" & i & ":" & "H" & i)
      REFA.Select
      Selection.Copy
 
      Worksheets(2).Activate
      Set REFB = Range("A" & Ligne & ":" & "H" & Ligne)
      REFB.Select
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False
 
       End If
 
 Next i
 
End Sub

**Docmarti** · 03/05/2015, 14h50

Bonjour

Envoyé par RyuAutodidacte

Re, je n'ai pas encore réussi à comprendre mon erreur sur le "On error…" PS : je suis tjs preneur pour que l'on m'explique

Tu aurais dû placer le Next I avant Exit Sub
comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 Next i
Exit Sub
ErrorHandler:

**Marc-L** · 03/05/2015, 15h11

Modification de la ligne n°9 de ma première démo pour copier uniquement les valeurs :

Rc.Resize(, Rw.Cells.Count).Value = Rw.Value …

Sinon pour comprendre un souci dans un code, l'exécuter en mode pas à pas via la touche F8
tout en contrôlant le contenu de la fenêtre des Variables locales …

**RyuAutodidacte** · 03/05/2015, 16h06

Marc-L,
je reviens vers toi car en faisant d'autre test avec ton code (Demo2) sur mon fichier source je me suis aperçu d'un petit détail :
le remplacement des infos à réf equivalentes de la feuil1 à la feuil2 est ok et l'ajout d'une nouvelle référence sur la feuil2 derrière la dernière réf est ok sauf que :
La 1ère fois que je lance le script il créé sur la dernière ligne de la feuil2 une case vide considéré comme pleine (1è cellule vide rencontrée aprè la dernière Réf en Col A) donc, quand je lance une 2è fois le script avec ajout d'une nouvelle Réf, ca me fait une ligne vide entre 2 réfs (
Et quand je relance de nouveau tout est ok par la suite pas de ligne vide

En y réfléchissant je suppose que c'est dû peut être à ma tétiêre de ma feuil2 se trouvant sur A1:H1

du coup pour pallier à ce détail j'ai codé à la suite de ton code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
   DerL = Sheets("Feuil2").Cells(Rows.Count, 2).End(xlUp)(2).Row
   Range("A" & DerL & ":" & "H" & DerL).Clear

A moins que tu es une meilleure solution

En tout cas merci bien car c'est vraiment top et rapide

Merci pour la modif de Demo1

PS : Merci Docmarti je vais modifier et tester

Tu aurais dû placer le Next I avant Exit Sub

**Marc-L** · 03/05/2015, 18h25

Pas reproduit de mon côté, ressemble à une ligne vide qui n'en est pas une !

Utiliser la propriété Range.End sur la première colonne …

Sinon joindre un classeur de données en .xlsx (sans code) pour pouvoir tester.

Problème d'un rechercher/remplacer spécifique (!PC et MAC!) [XL-MAC 2011]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager