Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel VBA - Copiage unique + ecrire chaque valeur

VBA - Copiage unique + ecrire chaque valeur

11 réponses
Avatar
Apitos
Salut;

J'ai dans la colonne A des produits qui se repetent tout au lng de la
colonne

Dans la colonne B des valeurs.

J'aimerias avoir dans la colonne D tout les produits uniques de la
colonne A (Chose faite) et devant chaque produit on ecrira ses valeurs
trouv=E9 dans la colonne B.

Si on a :

A ------- B
M10 -- 10
k12 --- 8
M10 -- 45
M10 -- 11
M88 -- 21
M88 -- 74

Le resulat doit etre :

D ------ E ------ F ------ G ------ H ----- I
k12 --- 8
M10 -- 10 ----- 11 ----- 45
M88 -- 21 ----- 74

et ainsi de suite.

Merci.
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
JB
Bonjour,

[E1:M10].ClearContents
[A1:A1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[E1],
Unique:=True
For Each c In Range([A2], [A65000].End(xlUp))
[E:E].Find(c).Select
Cells(ActiveCell.Row, 255).End(xlToLeft).Offset(0, 1) =
c.Offset(0, 1)
Next c

http://cjoint.com/?fDiz0wwjDa

JB

On 29 mai, 05:54, Apitos wrote:
Salut;

J'ai dans la colonne A des produits qui se repetent tout au lng de la
colonne

Dans la colonne B des valeurs.

J'aimerias avoir dans la colonne D tout les produits uniques de la
colonne A (Chose faite) et devant chaque produit on ecrira ses valeurs
trouvé dans la colonne B.

Si on a :

A ------- B
M10 -- 10
k12 --- 8
M10 -- 45
M10 -- 11
M88 -- 21
M88 -- 74

Le resulat doit etre :

D ------ E ------ F ------ G ------ H ----- I
k12 --- 8
M10 -- 10 ----- 11 ----- 45
M88 -- 21 ----- 74

et ainsi de suite.

Merci.


Avatar
Apitos
Merci JB.

Si on veut écrire ce code dans un évenement Worksheet_Change.

Quel changement devrais-je apporté au code ?

Merci.
Avatar
JB
http://cjoint.com/?fDoiAZBf11

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
[A1:A1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[E1],
Unique:=True
End If
If Target.Column = 2 Then
Application.EnableEvents = False
Application.ScreenUpdating = False
[F1:M10].ClearContents
For Each c In Range([A2], [A65000].End(xlUp))
Set x = [E:E].Find(c)
Cells(x.Row, 255).End(xlToLeft).Offset(0, 1) = c.Offset(0, 1)
Next c
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub

JB

On 29 mai, 13:28, Apitos wrote:
Merci JB.

Si on veut écrire ce code dans un évenement Worksheet_Change.

Quel changement devrais-je apporté au code ?

Merci.


Avatar
Apitos
On 29 mai, 14:08, JB wrote:
http://cjoint.com/?fDoiAZBf11

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
[A1:A1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[E1],
Unique:=True
End If
If Target.Column = 2 Then
Application.EnableEvents = False
Application.ScreenUpdating = False
[F1:M10].ClearContents
For Each c In Range([A2], [A65000].End(xlUp))
Set x = [E:E].Find(c)
Cells(x.Row, 255).End(xlToLeft).Offset(0, 1) = c.Offset(0, 1)
Next c
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub

JB

On 29 mai, 13:28, Apitos wrote:



Merci JB.

Si on veut écrire ce code dans un évenement Worksheet_Change.

Quel changement devrais-je apporté au code ?

Merci.- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


Grand merci à toi JB.


Avatar
Apitos
J'ai un probléme :

Comment rendre find sensible à la casse ?

Merci.
Avatar
MichDenis
Regarde dans l'aide, la méthode Find a un paramètre qui fait ce travail :

MatchCase Argument de type Variant facultatif. Affectez-lui la valeur True pour que la
recherche respecte la casse. La valeur par défaut est False.



"Apitos" a écrit dans le message de news:

J'ai un probléme :

Comment rendre find sensible à la casse ?

Merci.
Avatar
JB
Bonjour,

http://cjoint.com/?fEoEsSTbJu

Set x = [E:E].Find(c, MatchCase:úlse, LookAt:=xlWhole)

JB

On 30 mai, 13:31, Apitos wrote:
J'ai un probléme :

Comment rendre find sensible à la casse ?

Merci.


Avatar
Apitos
Merci JB ainsi que MichDenis.
Avatar
Apitos
Salut,

Comment faire pour éviter la répétition des valeurs dans la
transformation ?

Par exemple si j'ai deux M88 = 10, dans le deuxieme tableau j'aimerais
avoir une seule valeur M88 = 10.

Merci.
Avatar
JB
http://cjoint.com/?gdvfrSrnJI

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
[A1:A1000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[E1],
Unique:=True
End If
If Target.Column = 2 Then
Application.EnableEvents = False
Application.ScreenUpdating = False
[F1:M10].ClearContents
For Each c In Range([A2], [A65000].End(xlUp))
Set x = [E:E].Find(c, MatchCase:úlse, LookAt:=xlWhole)
Set y = Cells(x.Row, 6).Resize(1, 199).Find(c.Offset(0,
1).Value, LookAt:=xlWhole)
If y Is Nothing Then
Cells(x.Row, 255).End(xlToLeft).Offset(0, 1) = c.Offset(0,
1).Value
End If
Next c
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub

JB



On 3 juin, 20:24, Apitos wrote:
Salut,

Comment faire pour éviter la répétition des valeurs dans la
transformation ?

Par exemple si j'ai deux M88 = 10, dans le deuxieme tableau j'aimerais
avoir une seule valeur M88 = 10.

Merci.


1 2