VBA: rechercher occurrence + rapatriement données liéées

Version imprimable

12/10/2014, 17h34
clorion91

1 pièce(s) jointe(s)

VBA: rechercher occurrence + rapatriement données liéées

Bonjour,

J'aimerais programmer une macro qui: quand un utilisateur colle des éléments dans une colonne précise d'un tableau, la macro va chercher dans une seconde feuille les occurrences trouvées et ensuite rapatrier dans le tableau initial des informations liées aux occurrences trouvées.

Exemple:

On colle dans la colonne la référence 500000, la macro va chercher cette valeur dans la feuille 2 et va rapatrier les informations liées à cette référence dans le tableau de base si cette référence s'y trouve. Si elle ne s'y trouve pas, alors la macro s'arrête.

Je vous joins un exemple de tableau.

Habituellement, j'utilise la combinaison INDEX+EQUIV mais j'aimerais quelque chose de plus propre en passant par le VBA.

Pouvez-vous m'aider?

Merci par avance.

Bonne journée.

Bonjour Clorion, bonjour le forum,

Peut-être comme ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range 'déclare la variable R (Recherche)
Dim I As Byte 'déclare la variable I (Incrément)
 
If Target.Column <> 1 Then Exit Sub 'si la colonne de la cellule modifiée est différente de 1 (=A), sort de la procédure
'définit la recherche R (recherche la valeur de la cellule modifiée (Target) dans la colonne 1 (=A) de l'onglet "Feuil2"
Set R = Sheets("Feuil2").Columns(1).Find(Target.Value, , xlValues, xlWhole)
If Not R Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    For I = 1 To 3 'boucle de un à 3
        'récuprère les données dans la colonne décalée de I vers la droite
        Target.Offset(0, I).Value = R.Offset(0, I).Value
    Next I 'prochaine valeur de la boucle
End If 'fin de la condition
End Sub

13/10/2014, 09h32
Marc-L

Bonjour, bonjour !

Citation:

Envoyé par clorion91

Habituellement, j'utilise la combinaison INDEX+EQUIV mais j'aimerais quelque chose de plus propre en passant par le VBA.

En VBA on utilise aussi les fonctions de feuilles de calculs car c'est souvent le plus rapide !
14/10/2014, 19h38
clorion91

Bonsoir Thautheme,

Tout d'abord, merci pour ta réponse.

Je viens de tester et effectivement, c'est quasi parfait.

Le seul problème étant que dans ce tableau, les colonnes où nous devons rapatrier les éléments souhaités se succèdent tandis que dans le fichier final que je souhaite compléter, ces dernières se trouvent à divers endroits de la matrice.

Par exemple, Colonne LIB se trouvera en colonne B tandis que la colonne PCB se trouvera en colonne X . Et entre les deux, le tableau contiendra des formules ou données déjà présentes.

Le rapatriement des données en décalant de la cellule de recherche ne peut donc fonctionner.

Il faudrait idéalement que: une fois que la macro ait trouvé l'occurrence: cette dernière envoie l'info de telle cellule dans telle cellule du tableau etc.

Si possible d'avoir une codification permettant cela, je suis preneur :)

Bonsoir Marc-L,

Effectivement, j'ai déjà essayé de retranscrire les formules INDEX et Equiv en macro mais je trouve que c'est lourd à traiter, notamment le collage de la formule sur les cellules suivantes et le collage spéciale valeur avant de finaliser l'action de la macro.

En vous remerciant par avance.

Bonne soirée.

Clorion91
14/10/2014, 20h20
Philippe Tulliez
Bonjour,

Citation:

Effectivement, j'ai déjà essayé de retranscrire les formules INDEX et Equiv en macro mais je trouve que c'est lourd à traiter, notamment le collage de la formule sur les cellules suivantes et le collage spéciale valeur avant de finaliser l'action de la macro.

Le collage spécial-Valeur n'est pas indispensable, il y a plus simple
Exemple avec une formule de concaténation.
Code:

1 2 3 4 With ThisWorkbook.Worksheets("db").Range("H2:H200") .Formula = "=B2 & "" "" & C2" .Value = .Value ' Conserve la valeur End With

Bonsoir,

Merci beaucoup pour le petit conseil.
J'ai donc modifié ma macro et cela fonctionne parfaitement!
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Private Sub Worksheet_Change(ByVal Target As Range) Dim R As Range 'déclare la variable R (Recherche) Dim Ligne As Integer Dim Colonne As Integer Dim Colonne_PCB As String Colonne_PCB = "B" Ligne = Target.Row Colonne = Target.Column If Target.Column <> 1 Then Exit Sub 'si la colonne de la cellule modifiée est différente de 1 (=A), sort de la procédure 'définit la recherche R (recherche la valeur de la cellule modifiée (Target) dans la colonne 1 (=A) de l'onglet "Feuil2" Set R = Sheets("Feuil2").Columns(1).Find(Target.Value, , xlValues, xlWhole) If Not R Is Nothing Then 'condition : si il existe au moins une occurrence trouvée With ThisWorkbook.Worksheets("Feuil1").Range("$" & Colonne_PCB & Ligne) .Formula = "=IFERROR(INDEX(Feuil2!R1C1:R2C10,MATCH(Feuil1!RC1,Feuil2!R1C1:R2C1,0),2),"""")" .Value = .Value ' Conserve la valeur End With End If End Sub
Le seul petit problème, c'est que la macro Private Sub Worksheet_Change ne s'exécute pas correctement lorsque l'on effectue un copier/coller: la macro ne se lance pas. Il faut donc cliquer sur chaque cellule pour que la macro se lance une fois avoir coller nos données.

Avez-vous une astuce pour palier à cela?

Merci par avance.

Clorion91

15/10/2014, 06h57
Philippe Tulliez

Bonjour,
A la première lecture, je vois deux problèmes
1) En écrivant la formule dans une cellule, tu provoques à nouveau un événement Change et la procédure boucle. Il faut ajouter la ligne

Code:

Application.EnableEvents = False

Juste après la ligne 11 de ta procédure et sans oublier de remettre la propriété à True avant de quitter la procédure
2) Tu écris une formule de style R1C1 en choisissant la propriété Formula au lieu FormulaR1C1
Il y a peut-être d'autres soucis mais ce n'est qu'une lecture et pas un test
15/10/2014, 20h33
clorion91

1 pièce(s) jointe(s)

Bonsoir,

Merci pour ces éléments que je viens de rajouter.

Effectivement, je connais quelques bases en VBA et comprends très vite les codes que l'on me montre mais c'est certain qu'il me manque du vocabulaire VBA ainsi que quelques astuces pour construire moi-même correctement une macro.

Si vous connaissez des livres détaillant bien ces domaines, je suis preneur :)

Par ailleurs, la macro fonctionne donc bien sauf lorsque j'effectue le copier/coller, là la formule s'applique bien sur la première ligne du tableau destinataire mais pas sur celles qui suivent, sauf en passant un par un sur les éléments que j'ai collé: là la macro fonctionne.

Avez-vous une idée?
Ci-joint le fichier en guise d'exemple.

Merci par avance

Bonne soirée.

Jonathan
15/10/2014, 23h23
clementmarcotte

Bonjour,

Citation:

Envoyé par clorion91

Bonsoir,

Si vous connaissez des livres détaillant bien ces domaines, je suis preneur :)

Jonathan

Un tour par là pour commencer ;) :

http://excel.developpez.com/cours/

et aussi par là:

http://excel.developpez.com/livres/

Bonjour,

Citation:

Par ailleurs, la macro fonctionne donc bien sauf lorsque j'effectue le copier/coller, là la formule s'applique bien sur la première ligne du tableau destinataire mais pas sur celles qui suivent, sauf en passant un par un sur les éléments que j'ai collé: là la macro fonctionne.

Cela provient du fait que tu travailles avec la ligne et la colonne de l'objet Target. C'est à dire une seule cellule or si tu colles plusieurs cellules et que tu souhaites placer ta formule sur l'ensemble de la colonne se trouvant à droite de la plage collée et en supposant bien entendu que tu ne colles qu'une seule colonne.
Voici un exemple où j'ai simplement apporté des modifications à ta procédure (mis en rouge) en utilisant une plage de cellules A1:F201 de la feuille nommée Feuil2
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Private Sub Worksheet_Change(ByVal Target As Range) Dim R As Range 'déclare la variable R (Recherche) Dim Ligne As Integer, Colonne As Integer Dim Colonne_PCB As String Colonne_PCB = "B" Ligne = Target.Row Colonne = Target.Column If Target.Column <> 1 Then Exit Sub 'si la colonne de la cellule modifiée est différente de 1 (=A), sort de la procédure 'définit la recherche R (recherche la valeur de la cellule modifiée (Target) dans la colonne 1 (=A) de l'onglet "Feuil2" Application.EnableEvents = False Set R = Sheets("Feuil2").Columns(1).Find(Target.Value, , xlValues, xlWhole) If Not R Is Nothing Then 'condition : si il existe au moins une occurrence trouvée With Target.Offset(columnoffset:=1) ' Déplacement d'une colonne par rapport à target .FormulaR1C1 = "=IFERROR(INDEX(Feuil2!R1C1:R201C6,MATCH(Feuil1!RC1, Feuil2!R1C1:R201C1,0),2),"""")" .Value = .Value ' Conserve la valeur End With End If Application.EnableEvents = True End Sub
Pour rendre pérenne ta procédure, il faudrait bien entendu adapter la formule de telle manière que la dimension de la plage soit calculée dynamiquement.