Discussion :

[clorion91]

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.

[Thautheme]

Bonjour Clorion, bonjour le forum,

Peut-être comme ça :

Code :

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

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

[Marc-L]

Bonjour, bonjour !

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 !

[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

[Philippe Tulliez]

Bonjour,

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 :

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

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

[clorion91]

Bonsoir,

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

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

[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 :

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

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