VBA - Copiage unique + ecrire chaque valeur

Le
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é 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.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
JB
Le #4542451
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
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.


Apitos
Le #4541961
Merci JB.

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

Quel changement devrais-je apporté au code ?

Merci.
JB
Le #4541841
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
Merci JB.

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

Quel changement devrais-je apporté au code ?

Merci.


Apitos
Le #4550611
On 29 mai, 14:08, 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


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.


Apitos
Le #4572981
J'ai un probléme :

Comment rendre find sensible à la casse ?

Merci.
MichDenis
Le #4572941
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"
J'ai un probléme :

Comment rendre find sensible à la casse ?

Merci.
JB
Le #4572811
Bonjour,

http://cjoint.com/?fEoEsSTbJu

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

JB

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

Comment rendre find sensible à la casse ?

Merci.


Apitos
Le #4570801
Merci JB ainsi que MichDenis.
Apitos
Le #4563291
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.
JB
Le #4563211
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
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.


Publicité
Poster une réponse
Anonyme