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-Tri sans doublons selon un critère

VBA-Tri sans doublons selon un critère

7 réponses
Avatar
Pierre.M
Bonsoir a tous,

Quelqu'un pourrait-il m'aider a creer la macro qui me depannerait ?
J'ai déjà vu passer la solution avec des noms/prenoms, mais je n'arrive
pas à remettre la main dessus...

Dans un tableau T1 je rentre en colonne A des noms que j'associe en
colonne B à des villes. Je peux avoir plusieurs fois le meme nom,
associee a la meme ville ou encore a une autre ville.

J'aimerais recuperer dans un tableau T2 tous les noms differents (sans
doublons) du tableau T1 dans des colonnes classees par villes. Si le
nom existe deja pour une ville donnee rien ne se passe, sinon il se
rajoute au tableau T2.

Je voudrais que cela se fasse au fur et a mesure de la saisie (apres
validation de la ville) ou éventuellement au changement de feuille.

Merci beaucoup pour votre aide et bonne soiree a tous.

Pierre.M
Signaler un problème avec ce contenu

7 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
Avatar
JB
Bonsoir,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[A1:B10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=
[G1:H1], Unique:=True
End If
End Sub

http://cjoint.com/?mtu7TyGQLf

JB
http://boisgontierjacques.free.fr/


On 19 déc, 17:32, Pierre.M wrote:
Bonsoir a tous,

Quelqu'un pourrait-il m'aider a creer la macro qui me depannerait ?
J'ai déjà vu passer la solution avec des noms/prenoms, mais je n'arri ve
pas à remettre la main dessus...

Dans un tableau T1 je rentre en colonne A des noms que j'associe en
colonne B à des villes. Je peux avoir plusieurs fois le meme nom,
associee a la meme ville ou encore a une autre ville.

J'aimerais recuperer dans un tableau T2 tous les noms differents (sans
doublons) du tableau T1 dans des colonnes classees par villes. Si le
nom existe deja pour une ville donnee rien ne se passe, sinon il se
rajoute au tableau T2.

Je voudrais que cela se fasse au fur et a mesure de la saisie (apres
validation de la ville) ou éventuellement au changement de feuille.

Merci beaucoup pour votre aide et bonne soiree a tous.

Pierre.M


Avatar
Pierre.M
Merci beaucoup pour ton aide une fois encore.

Cependant j'ai du mal me faire comprendre, dans le 2eme tableau de ton
exemple (colonnes G et H)il devrait y avoir les 2 colonnes : Paris et
Lyon.
Dans la colonne Paris on aurait : Dupont, Martin et Balu et dans la
colonne Lyon : Durand, Dupont et Martin (en ordre alphabetique ça
serait parfait, mais pas forcement utile...).

Merci encore et bon week-end.

Pierre.M



On 2008-12-19 20:12:40 +0100, JB said:

Bonsoir,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[A1:B10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:
[G1:H1], Unique:=True
End If
End Sub

http://cjoint.com/?mtu7TyGQLf

JB
http://boisgontierjacques.free.fr/


On 19 déc, 17:32, Pierre.M wrote:
Bonsoir a tous,

Quelqu'un pourrait-il m'aider a creer la macro qui me depannerait ?
J'ai déjà vu passer la solution avec des noms/prenoms, mais je n'arri


ve
pas à remettre la main dessus...

Dans un tableau T1 je rentre en colonne A des noms que j'associe en
colonne B à des villes. Je peux avoir plusieurs fois le meme nom,
associee a la meme ville ou encore a une autre ville.

J'aimerais recuperer dans un tableau T2 tous les noms differents (sans
doublons) du tableau T1 dans des colonnes classees par villes. Si le
nom existe deja pour une ville donnee rien ne se passe, sinon il se
rajoute au tableau T2.

Je voudrais que cela se fasse au fur et a mesure de la saisie (apres
validation de la ville) ou éventuellement au changement de feuille.

Merci beaucoup pour votre aide et bonne soiree a tous.

Pierre.M




Avatar
JB
Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[E1:I100].ClearContents
Set MonDico = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In Range("b2", [b65000].End(xlUp))
temp = c.Value & c.Offset(0, -1).Value
If Not MonDico2.Exists(temp) Then
temp = c.Value & c.Offset(0, -1).Value
MonDico2.Add temp, temp
If Not MonDico.Exists(c.Value) Then
MonDico(c.Value) = c.Offset(0, -1) & " "
Else
MonDico(c.Value) = MonDico(c.Value) & c.Offset(0, -1) & " "
End If
End If
Next c
a = MonDico.keys
b = MonDico.items
For i = LBound(b) To UBound(b)
Cells(1, i + 5) = a(i)
c = Split(b(i), " ")
Cells(2, i + 5).Resize(UBound(c), 1) = Application.Transpose(c)
Next i
End If
End Sub

http://cjoint.com/?muknWQey4D

JB

On 19 déc, 23:22, Pierre.M wrote:
Merci beaucoup pour ton aide une fois encore.

Cependant j'ai du mal me faire comprendre, dans le 2eme tableau de ton
exemple (colonnes G et H)il devrait y avoir les 2 colonnes : Paris et
Lyon.
Dans la colonne Paris on aurait : Dupont, Martin et Balu et dans la
colonne Lyon : Durand, Dupont et Martin (en ordre alphabetique ça
serait parfait, mais pas forcement utile...).

Merci encore et bon week-end.

Pierre.M

On 2008-12-19 20:12:40 +0100, JB said:



> Bonsoir,

> Private Sub Worksheet_Change(ByVal Target As Range)
>   If Target.Column = 2 Then
>     [A1:B10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:
> [G1:H1], Unique:=True
>   End If
> End Sub

>http://cjoint.com/?mtu7TyGQLf

> JB
>http://boisgontierjacques.free.fr/

> On 19 déc, 17:32, Pierre.M wrote:
>> Bonsoir a tous,

>> Quelqu'un pourrait-il m'aider a creer la macro qui me depannerait ?
>> J'ai déjà vu passer la solution avec des noms/prenoms, mais je n'a rri
> ve
>> pas à remettre la main dessus...

>> Dans un tableau T1 je rentre en colonne A des noms que j'associe en
>> colonne B à des villes. Je peux avoir plusieurs fois le meme nom,
>> associee a la meme ville ou encore a une autre ville.

>> J'aimerais recuperer dans un tableau T2 tous les noms differents (sans
>> doublons) du tableau T1 dans des colonnes classees par villes. Si le
>> nom existe deja pour une ville donnee rien ne se passe, sinon il se
>> rajoute au tableau T2.

>> Je voudrais que cela se fasse au fur et a mesure de la saisie (apres
>> validation de la ville) ou éventuellement au changement de feuille.

>> Merci beaucoup pour votre aide et bonne soiree a tous.

>> Pierre.M- Masquer le texte des messages précédents -

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


Avatar
Pierre.M
Bonsoir, et merci pour la macro (je ne pensais pas que ça serait aussi
compliqué...).

Helas, pas moyen de l'utiliser.
En fait, mon employeur preferant continuer a utiliser Excel 97, je
pense que le probleme vient de là.
Ta macro ne peut fonctionner chez moi, la fonction "Split" n'etant pas
reconnue...

J'ai moyen de contourner le probleme s'il etait possible de faire la
meme chose que plus haut, mais avec une seule ville.
Le tableau T1 fonctionnerait pareillement qu'avant (en rentrant les
noms de villes qu'il faut), mais le tableau T2 n'aurait qu'une seule
colonne avec une seule ville (disons Paris) et serait sur une autre
feuille.
Est-ce possible et cela simplifie-t-il la macro ?

Desole pour le derangement et merci encore pour le temps que tu me
consacre (le WE qui plus est !).

Pierre.M





On 2008-12-20 09:26:53 +0100, JB said:

Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[E1:I100].ClearContents
Set MonDico = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In Range("b2", [b65000].End(xlUp))
temp = c.Value & c.Offset(0, -1).Value
If Not MonDico2.Exists(temp) Then
temp = c.Value & c.Offset(0, -1).Value
MonDico2.Add temp, temp
If Not MonDico.Exists(c.Value) Then
MonDico(c.Value) = c.Offset(0, -1) & " "
Else
MonDico(c.Value) = MonDico(c.Value) & c.Offset(0, -1) & " "
End If
End If
Next c
a = MonDico.keys
b = MonDico.items
For i = LBound(b) To UBound(b)
Cells(1, i + 5) = a(i)
c = Split(b(i), " ")
Cells(2, i + 5).Resize(UBound(c), 1) = Application.Transpose(c)
Next i
End If
End Sub

http://cjoint.com/?muknWQey4D

JB

On 19 déc, 23:22, Pierre.M wrote:
Merci beaucoup pour ton aide une fois encore.

Cependant j'ai du mal me faire comprendre, dans le 2eme tableau de ton
exemple (colonnes G et H)il devrait y avoir les 2 colonnes : Paris et
Lyon.
Dans la colonne Paris on aurait : Dupont, Martin et Balu et dans la
colonne Lyon : Durand, Dupont et Martin (en ordre alphabetique ça
serait parfait, mais pas forcement utile...).

Merci encore et bon week-end.

Pierre.M

On 2008-12-19 20:12:40 +0100, JB said:



Bonsoir,



Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 2 Then
    [A1:B10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:
[G1:H1], Unique:=True
  End If
End Sub



http://cjoint.com/?mtu7TyGQLf



JB
http://boisgontierjacques.free.fr/



On 19 déc, 17:32, Pierre.M wrote:
Bonsoir a tous,





Quelqu'un pourrait-il m'aider a creer la macro qui me depannerait ?
J'ai déjà vu passer la solution avec des noms/prenoms, mais je n'a






rri
ve
pas à remettre la main dessus...





Dans un tableau T1 je rentre en colonne A des noms que j'associe en
colonne B à des villes. Je peux avoir plusieurs fois le meme nom,
associee a la meme ville ou encore a une autre ville.





J'aimerais recuperer dans un tableau T2 tous les noms differents (sans
doublons) du tableau T1 dans des colonnes classees par villes. Si le
nom existe deja pour une ville donnee rien ne se passe, sinon il se
rajoute au tableau T2.





Je voudrais que cela se fasse au fur et a mesure de la saisie (apres
validation de la ville) ou éventuellement au changement de feuille.





Merci beaucoup pour votre aide et bonne soiree a tous.





Pierre.M- Masquer le texte des messages précédents -





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




Avatar
Mishell
Bonjour.
Il suffit de remplacer la fonction SPLIT inexistante dans Excel 97 par la
fonction Dissocier ci-incluse proposée par Microsoft.

Dim d As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[E1:I100].ClearContents
Set MonDico = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In Range("b2", [b65000].End(xlUp))
temp = c.Value & c.Offset(0, -1).Value
If Not MonDico2.Exists(temp) Then
temp = c.Value & c.Offset(0, -1).Value
MonDico2.Add temp, temp
If Not MonDico.Exists(c.Value) Then
MonDico(c.Value) = c.Offset(0, -1) & " "
Else
MonDico(c.Value) = MonDico(c.Value) & c.Offset(0, -1) & " "
End If
End If
Next c
a = MonDico.keys
b = MonDico.items
For i = LBound(b) To UBound(b)
Cells(1, i + 5) = a(i)
Dim Chaine As String
Chaine = b(i)
d = Dissocier(Chaine, " ")
Cells(2, i + 5).Resize(UBound(d), 1) = Application.Transpose(d)
Next i
End If
End Sub

Function Dissocier(Chaîne As String, Optional Balise As String = _
" ") As Variant


Dim Éléments() As String, LongChaîne As Long, PrécBalise As Long
K = -1
'Cas où aucune balise n'est spécifiée : le tableau n'a qu'une
'entrée qui contient toute la chaîne
If Len(Balise) = 0 Then
ReDim Éléments(0)
Éléments(0) = Chaîne
GoTo Fin
End If
Do
K = K + 1
LongChaîne = Len(Chaîne)
'Recherche le dernier caractère avant la balise
PrécBalise = InStr(1, Chaîne, Balise, vbBinaryCompare) - 1
'Quand il n'y a plus d'occurrence de la balise, récupère
'la fin de la chaîne
If PrécBalise = -1 Then PrécBalise = LongChaîne
'Insère les données dans une entrée du tableau
ReDim Preserve Éléments(K)
Éléments(K) = Mid(Chaîne, 1, PrécBalise)
If PrécBalise = LongChaîne Then Exit Do
'Réduit la chaîne
Chaîne = Right(Chaîne, LongChaîne - PrécBalise - Len(Balise))
Loop
Fin:
Dissocier = Éléments()
End Function

Mishell


"Pierre.M" wrote in message
news:
Bonsoir, et merci pour la macro (je ne pensais pas que ça serait aussi
compliqué...).

Helas, pas moyen de l'utiliser.
En fait, mon employeur preferant continuer a utiliser Excel 97, je pense
que le probleme vient de là.
Ta macro ne peut fonctionner chez moi, la fonction "Split" n'etant pas
reconnue...

J'ai moyen de contourner le probleme s'il etait possible de faire la meme
chose que plus haut, mais avec une seule ville.
Le tableau T1 fonctionnerait pareillement qu'avant (en rentrant les noms
de villes qu'il faut), mais le tableau T2 n'aurait qu'une seule colonne
avec une seule ville (disons Paris) et serait sur une autre feuille.
Est-ce possible et cela simplifie-t-il la macro ?

Desole pour le derangement et merci encore pour le temps que tu me
consacre (le WE qui plus est !).

Pierre.M





On 2008-12-20 09:26:53 +0100, JB said:

Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[E1:I100].ClearContents
Set MonDico = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In Range("b2", [b65000].End(xlUp))
temp = c.Value & c.Offset(0, -1).Value
If Not MonDico2.Exists(temp) Then
temp = c.Value & c.Offset(0, -1).Value
MonDico2.Add temp, temp
If Not MonDico.Exists(c.Value) Then
MonDico(c.Value) = c.Offset(0, -1) & " "
Else
MonDico(c.Value) = MonDico(c.Value) & c.Offset(0, -1) & " "
End If
End If
Next c
a = MonDico.keys
b = MonDico.items
For i = LBound(b) To UBound(b)
Cells(1, i + 5) = a(i)
c = Split(b(i), " ")
Cells(2, i + 5).Resize(UBound(c), 1) = Application.Transpose(c)
Next i
End If
End Sub

http://cjoint.com/?muknWQey4D

JB

On 19 déc, 23:22, Pierre.M wrote:
Merci beaucoup pour ton aide une fois encore.

Cependant j'ai du mal me faire comprendre, dans le 2eme tableau de ton
exemple (colonnes G et H)il devrait y avoir les 2 colonnes : Paris et
Lyon.
Dans la colonne Paris on aurait : Dupont, Martin et Balu et dans la
colonne Lyon : Durand, Dupont et Martin (en ordre alphabetique ça
serait parfait, mais pas forcement utile...).

Merci encore et bon week-end.

Pierre.M

On 2008-12-19 20:12:40 +0100, JB said:



Bonsoir,



Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[A1:B10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:
[G1:H1], Unique:=True
End If
End Sub



http://cjoint.com/?mtu7TyGQLf



JB
http://boisgontierjacques.free.fr/



On 19 déc, 17:32, Pierre.M wrote:
Bonsoir a tous,





Quelqu'un pourrait-il m'aider a creer la macro qui me depannerait ?
J'ai déjà vu passer la solution avec des noms/prenoms, mais je n'a






rri
ve
pas à remettre la main dessus...





Dans un tableau T1 je rentre en colonne A des noms que j'associe en
colonne B à des villes. Je peux avoir plusieurs fois le meme nom,
associee a la meme ville ou encore a une autre ville.





J'aimerais recuperer dans un tableau T2 tous les noms differents (sans
doublons) du tableau T1 dans des colonnes classees par villes. Si le
nom existe deja pour une ville donnee rien ne se passe, sinon il se
rajoute au tableau T2.





Je voudrais que cela se fasse au fur et a mesure de la saisie (apres
validation de la ville) ou éventuellement au changement de feuille.





Merci beaucoup pour votre aide et bonne soiree a tous.





Pierre.M- Masquer le texte des messages précédents -





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








Avatar
Pierre.M
Merci pour ton intervention.
Helas le resultat n'est pas meilleur; j'obtiens toujours une erreur de
compilation : "Sub ou function non definie"...
Peut-etre aurais-tu une solution a ma question alternative sur
l'extraction des noms pour une seule ville choisie une fois pour toute
dans la macro ? Je pourrais m'en sortir avec ça aussi.
Merci encore et bon après-midi.

Pierre.M


(On 2008-12-21 05:54:39 +0100, "Mishell" said:

Bonjour.
Il suffit de remplacer la fonction SPLIT inexistante dans Excel 97 par la
fonction Dissocier ci-incluse proposée par Microsoft.

Dim d As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[E1:I100].ClearContents
Set MonDico = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In Range("b2", [b65000].End(xlUp))
temp = c.Value & c.Offset(0, -1).Value
If Not MonDico2.Exists(temp) Then
temp = c.Value & c.Offset(0, -1).Value
MonDico2.Add temp, temp
If Not MonDico.Exists(c.Value) Then
MonDico(c.Value) = c.Offset(0, -1) & " "
Else
MonDico(c.Value) = MonDico(c.Value) & c.Offset(0, -1) & " "
End If
End If
Next c
a = MonDico.keys
b = MonDico.items
For i = LBound(b) To UBound(b)
Cells(1, i + 5) = a(i)
Dim Chaine As String
Chaine = b(i)
d = Dissocier(Chaine, " ")
Cells(2, i + 5).Resize(UBound(d), 1) = Application.Transpose(d)
Next i
End If
End Sub

Function Dissocier(Chaîne As String, Optional Balise As String = _
" ") As Variant


Dim Éléments() As String, LongChaîne As Long, PrécBalise As Long
K = -1
'Cas où aucune balise n'est spécifiée : le tableau n'a qu'une
'entrée qui contient toute la chaîne
If Len(Balise) = 0 Then
ReDim Éléments(0)
Éléments(0) = Chaîne
GoTo Fin
End If
Do
K = K + 1
LongChaîne = Len(Chaîne)
'Recherche le dernier caractère avant la balise
PrécBalise = InStr(1, Chaîne, Balise, vbBinaryCompare) - 1
'Quand il n'y a plus d'occurrence de la balise, récupère
'la fin de la chaîne
If PrécBalise = -1 Then PrécBalise = LongChaîne
'Insère les données dans une entrée du tableau
ReDim Preserve Éléments(K)
Éléments(K) = Mid(Chaîne, 1, PrécBalise)
If PrécBalise = LongChaîne Then Exit Do
'Réduit la chaîne
Chaîne = Right(Chaîne, LongChaîne - PrécBalise - Len(Balise))
Loop
Fin:
Dissocier = Éléments()
End Function

Mishell


"Pierre.M" wrote in message
news:
Bonsoir, et merci pour la macro (je ne pensais pas que ça serait aussi
compliqué...).

Helas, pas moyen de l'utiliser.
En fait, mon employeur preferant continuer a utiliser Excel 97, je pense
que le probleme vient de là.
Ta macro ne peut fonctionner chez moi, la fonction "Split" n'etant pas
reconnue...

J'ai moyen de contourner le probleme s'il etait possible de faire la meme
chose que plus haut, mais avec une seule ville.
Le tableau T1 fonctionnerait pareillement qu'avant (en rentrant les noms
de villes qu'il faut), mais le tableau T2 n'aurait qu'une seule colonne
avec une seule ville (disons Paris) et serait sur une autre feuille.
Est-ce possible et cela simplifie-t-il la macro ?

Desole pour le derangement et merci encore pour le temps que tu me
consacre (le WE qui plus est !).

Pierre.M





On 2008-12-20 09:26:53 +0100, JB said:

Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[E1:I100].ClearContents
Set MonDico = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In Range("b2", [b65000].End(xlUp))
temp = c.Value & c.Offset(0, -1).Value
If Not MonDico2.Exists(temp) Then
temp = c.Value & c.Offset(0, -1).Value
MonDico2.Add temp, temp
If Not MonDico.Exists(c.Value) Then
MonDico(c.Value) = c.Offset(0, -1) & " "
Else
MonDico(c.Value) = MonDico(c.Value) & c.Offset(0, -1) & " "
End If
End If
Next c
a = MonDico.keys
b = MonDico.items
For i = LBound(b) To UBound(b)
Cells(1, i + 5) = a(i)
c = Split(b(i), " ")
Cells(2, i + 5).Resize(UBound(c), 1) = Application.Transpose(c)
Next i
End If
End Sub

http://cjoint.com/?muknWQey4D

JB

On 19 déc, 23:22, Pierre.M wrote:
Merci beaucoup pour ton aide une fois encore.

Cependant j'ai du mal me faire comprendre, dans le 2eme tableau de ton
exemple (colonnes G et H)il devrait y avoir les 2 colonnes : Paris et
Lyon.
Dans la colonne Paris on aurait : Dupont, Martin et Balu et dans la
colonne Lyon : Durand, Dupont et Martin (en ordre alphabetique ça
serait parfait, mais pas forcement utile...).

Merci encore et bon week-end.

Pierre.M

On 2008-12-19 20:12:40 +0100, JB said:



Bonsoir,



Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[A1:B10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:
[G1:H1], Unique:=True
End If
End Sub



http://cjoint.com/?mtu7TyGQLf



JB
http://boisgontierjacques.free.fr/



On 19 déc, 17:32, Pierre.M wrote:
Bonsoir a tous,





Quelqu'un pourrait-il m'aider a creer la macro qui me depannerait ?
J'ai déjà vu passer la solution avec des noms/prenoms, mais je n'a






rri
ve
pas à remettre la main dessus...





Dans un tableau T1 je rentre en colonne A des noms que j'associe en
colonne B à des villes. Je peux avoir plusieurs fois le meme nom,
associee a la meme ville ou encore a une autre ville.





J'aimerais recuperer dans un tableau T2 tous les noms differents (sans
doublons) du tableau T1 dans des colonnes classees par villes. Si le
nom existe deja pour une ville donnee rien ne se passe, sinon il se
rajoute au tableau T2.





Je voudrais que cela se fasse au fur et a mesure de la saisie (apres
validation de la ville) ou éventuellement au changement de feuille.





Merci beaucoup pour votre aide et bonne soiree a tous.





Pierre.M- Masquer le texte des messages précédents -





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








Avatar
Mishell
Je l'ai testé sur Excel 97 et ça fonctionne sans problème étant donné que la
référence à la fonction Split n'existe plus.

Mishell

"Pierre.M" wrote in message
news:
Merci pour ton intervention.
Helas le resultat n'est pas meilleur; j'obtiens toujours une erreur de
compilation : "Sub ou function non definie"...
Peut-etre aurais-tu une solution a ma question alternative sur
l'extraction des noms pour une seule ville choisie une fois pour toute
dans la macro ? Je pourrais m'en sortir avec ça aussi.
Merci encore et bon après-midi.

Pierre.M


(On 2008-12-21 05:54:39 +0100, "Mishell" said:

Bonjour.
Il suffit de remplacer la fonction SPLIT inexistante dans Excel 97 par la
fonction Dissocier ci-incluse proposée par Microsoft.

Dim d As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[E1:I100].ClearContents
Set MonDico = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In Range("b2", [b65000].End(xlUp))
temp = c.Value & c.Offset(0, -1).Value
If Not MonDico2.Exists(temp) Then
temp = c.Value & c.Offset(0, -1).Value
MonDico2.Add temp, temp
If Not MonDico.Exists(c.Value) Then
MonDico(c.Value) = c.Offset(0, -1) & " "
Else
MonDico(c.Value) = MonDico(c.Value) & c.Offset(0, -1) & " "
End If
End If
Next c
a = MonDico.keys
b = MonDico.items
For i = LBound(b) To UBound(b)
Cells(1, i + 5) = a(i)
Dim Chaine As String
Chaine = b(i)
d = Dissocier(Chaine, " ")
Cells(2, i + 5).Resize(UBound(d), 1) = Application.Transpose(d)
Next i
End If
End Sub

Function Dissocier(Chaîne As String, Optional Balise As String = _
" ") As Variant


Dim Éléments() As String, LongChaîne As Long, PrécBalise As Long
K = -1
'Cas où aucune balise n'est spécifiée : le tableau n'a qu'une
'entrée qui contient toute la chaîne
If Len(Balise) = 0 Then
ReDim Éléments(0)
Éléments(0) = Chaîne
GoTo Fin
End If
Do
K = K + 1
LongChaîne = Len(Chaîne)
'Recherche le dernier caractère avant la balise
PrécBalise = InStr(1, Chaîne, Balise, vbBinaryCompare) - 1
'Quand il n'y a plus d'occurrence de la balise, récupère
'la fin de la chaîne
If PrécBalise = -1 Then PrécBalise = LongChaîne
'Insère les données dans une entrée du tableau
ReDim Preserve Éléments(K)
Éléments(K) = Mid(Chaîne, 1, PrécBalise)
If PrécBalise = LongChaîne Then Exit Do
'Réduit la chaîne
Chaîne = Right(Chaîne, LongChaîne - PrécBalise - Len(Balise))
Loop
Fin:
Dissocier = Éléments()
End Function

Mishell


"Pierre.M" wrote in message
news:
Bonsoir, et merci pour la macro (je ne pensais pas que ça serait aussi
compliqué...).

Helas, pas moyen de l'utiliser.
En fait, mon employeur preferant continuer a utiliser Excel 97, je pense
que le probleme vient de là.
Ta macro ne peut fonctionner chez moi, la fonction "Split" n'etant pas
reconnue...

J'ai moyen de contourner le probleme s'il etait possible de faire la
meme
chose que plus haut, mais avec une seule ville.
Le tableau T1 fonctionnerait pareillement qu'avant (en rentrant les noms
de villes qu'il faut), mais le tableau T2 n'aurait qu'une seule colonne
avec une seule ville (disons Paris) et serait sur une autre feuille.
Est-ce possible et cela simplifie-t-il la macro ?

Desole pour le derangement et merci encore pour le temps que tu me
consacre (le WE qui plus est !).

Pierre.M





On 2008-12-20 09:26:53 +0100, JB said:

Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[E1:I100].ClearContents
Set MonDico = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In Range("b2", [b65000].End(xlUp))
temp = c.Value & c.Offset(0, -1).Value
If Not MonDico2.Exists(temp) Then
temp = c.Value & c.Offset(0, -1).Value
MonDico2.Add temp, temp
If Not MonDico.Exists(c.Value) Then
MonDico(c.Value) = c.Offset(0, -1) & " "
Else
MonDico(c.Value) = MonDico(c.Value) & c.Offset(0, -1) & " "
End If
End If
Next c
a = MonDico.keys
b = MonDico.items
For i = LBound(b) To UBound(b)
Cells(1, i + 5) = a(i)
c = Split(b(i), " ")
Cells(2, i + 5).Resize(UBound(c), 1) = Application.Transpose(c)
Next i
End If
End Sub

http://cjoint.com/?muknWQey4D

JB

On 19 déc, 23:22, Pierre.M wrote:
Merci beaucoup pour ton aide une fois encore.

Cependant j'ai du mal me faire comprendre, dans le 2eme tableau de ton
exemple (colonnes G et H)il devrait y avoir les 2 colonnes : Paris et
Lyon.
Dans la colonne Paris on aurait : Dupont, Martin et Balu et dans la
colonne Lyon : Durand, Dupont et Martin (en ordre alphabetique ça
serait parfait, mais pas forcement utile...).

Merci encore et bon week-end.

Pierre.M

On 2008-12-19 20:12:40 +0100, JB said:



Bonsoir,



Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
[A1:B10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:
[G1:H1], Unique:=True
End If
End Sub



http://cjoint.com/?mtu7TyGQLf



JB
http://boisgontierjacques.free.fr/



On 19 déc, 17:32, Pierre.M wrote:
Bonsoir a tous,





Quelqu'un pourrait-il m'aider a creer la macro qui me depannerait ?
J'ai déjà vu passer la solution avec des noms/prenoms, mais je n'a






rri
ve
pas à remettre la main dessus...





Dans un tableau T1 je rentre en colonne A des noms que j'associe en
colonne B à des villes. Je peux avoir plusieurs fois le meme nom,
associee a la meme ville ou encore a une autre ville.





J'aimerais recuperer dans un tableau T2 tous les noms differents
(sans
doublons) du tableau T1 dans des colonnes classees par villes. Si le
nom existe deja pour une ville donnee rien ne se passe, sinon il se
rajoute au tableau T2.





Je voudrais que cela se fasse au fur et a mesure de la saisie (apres
validation de la ville) ou éventuellement au changement de feuille.





Merci beaucoup pour votre aide et bonne soiree a tous.





Pierre.M- Masquer le texte des messages précédents -





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