tri sans doublons

F

fifounet

Guest
Bonsoir tout le monde
je veux trier sans doublons plusieurs zones de cellules dans une seule colonne et sans les cellules vides
ex:
trier la zone A1:A10 et B1:B10 et A25:A30 et B25:B30
dans la colonne C à partir de C1
J'ai essayé avec un code 'AdvancedFilter' récupéré dans une autre application mais ça ne donne pas satisfaction.
merci de votre aide
fifounet
 

Hervé

XLDnaute Barbatruc
Bonsoir fifounet

Je ne sais pas si tu veux une solution par vba, mais en voilà une :

Nomme les cellules (insertion-nom-définir), dans l'exemple la plage nommée est : plage (original !!! non ?) et utilise ce code :

Option Explicit

Sub Bouton1_QuandClic()
Dim data As Collection
Dim c As Range
Dim i As Byte

Set data = New Collection

On Error Resume Next
For Each c In Range('plage')
    data.Add c, CStr(c)
Next c
On Error GoTo 0

For i = 1 To data.Count
    Cells(i, 3) = data(i)
Next i
End Sub


salut

Message édité par: Hervé, à: 23/11/2005 22:22
 
F

fifounet

Guest
Merci Hervé

c'est tout pile ce que je veux !
Est ce qu'on peut adapter pour ne trier que sur toutes les cellules nomées moins les 2 derniers caracteres de chaque cellule?
ex:
toto 1
tata 2
titi 3
toto 2

donnerait:
toto
tata
titi

merci beaucoup
fifounet
 

Hervé

XLDnaute Barbatruc
salut fifounet :)

comme ceci ?


Option Explicit

Sub Bouton1_QuandClic()
Dim data As Collection
Dim c As Range
Dim i As Byte

Set data = New Collection

On Error Resume Next
For Each c In Range('plage')
        data.Add Left(c, Len(c) - 2),
CStr(Left(c, Len(c) - 2))
Next c
On Error GoTo 0

For i = 1 To data.Count
        Cells(i, 3) = data(i)
Next i

End Sub


salut
 
F

fifounet

Guest
Bonjour à tous
merci encore Hervé pour ta soluce
apres essai dans mon tableau
je m'aperçois que la liste extraite doit obligatoirement commencer en ligne 1 sinon ça marche pas !
je suppose que la modif est tres simple mais je cale
(et oui vb pour moi c'est tjrs du chinois !)
autre amélioration:
au lieu de supprimer les 2 derniers caracteres
il faudrait plutot supprimer les derniers caracteres jusqu'au 1er blanc
en effet je peux avoir ceci
toto 1
tata 2
titi 1
toto 23
tata 125
etc...
chose que je découvre maintenant, c'était trop simple !!
merci de votre aide
fifounet
 

Hervé

XLDnaute Barbatruc
Salut fifounet, le forum

la liste s'extrait comme tu veux, il suffit que tu regles a ce niveau :

Cells(i, 3) = data(i)

fait varier le i pour le numéro de ligne de départ i+1 pour commencer en ligne 2, i+2 pour commencer en ligne 3, etc...

ou fait varier ta colonne le 3 pour C,4 pour D etc...

sinon, le code pour les histoires d'espaces:

Option Explicit

Sub Bouton1_QuandClic()
Dim data As Collection
Dim c As Range
Dim i As Byte, place As Byte

Set data = New Collection

On Error Resume Next
For Each c In Range('plage')
        place = InStr(1, c, ' ')
        data.Add Mid(c, 1, place - 1),
CStr(Mid(c, 1, place - 1))
Next c
On Error GoTo 0

For i = 1 To data.Count
        Cells(i, 3) = data(i)
Next i

End Sub

salut
 
F

fifounet

Guest
Merci Hervé pour ta patience et tes explications
la formule fonctionne mais car il y a un mais:
je veux garder le texte avant le dernier blanc
pour supprimer les 1 2 ou 3 caracteres qui suivent comme ceci:

toto lili 1
titi lolo juju 2
tata 32
titi jojo 25

donnerait:

toto lili
titi lolo juju
tata
titi jojo

c'est vrai que dans mon 1er exemple je ne précisait pas qu'il pouvait y avoir 2 ou plusieurs blancs
désolé
merci d'avance
fifounet
 

Hervé

XLDnaute Barbatruc
salut fifounet, le forum

Fifounet, c'est le 4ème code que je te donne, tu es bien sur qu'il ne manque plus rien ce coup là :)


Sub Bouton1_QuandClic()
Dim data As Collection
Dim c As Range
Dim i As Integer
Dim place As Byte


Set data = New Collection

On Error Resume Next
For Each c In Range('plage')
       
For i = Len(c) To 1 Step -1
               
If Mid(c, i, 1) = ' ' Then Exit For
       
Next i
        data.Add Mid(c, 1, i - 1),
CStr(Mid(c, 1, i - 1))
Next c
On Error GoTo 0

For i = 1 To data.Count
                Cells(i, 3) = data(i)
Next i

End Sub


salut
 

Discussions similaires

Réponses
13
Affichages
402
Réponses
31
Affichages
1 K

Statistiques des forums

Discussions
312 396
Messages
2 088 054
Membres
103 709
dernier inscrit
FrrankX