Création d'une liste d'éléments dans une feuille

B

Benlo

Guest
Bonjour le forum,

Je cherche à créer une liste d'éléments dans une feuille à partir d'une très grande liste qui contient des doublons. J'ai déjà du code pour éliminer les doublons d'une liste mais je dois utiliser une autre feuille de 'travail' pour y épurer la liste car je ne peux pas modifier la liste originale.

Ma question est la suivante, peux-t-on créer une nouvelle liste sans doublon dans une nouvelle feuille sans passer par une troisième feuille ?

J'utilise ce code pour alimenter un listbox ou un combobox. L'avantage de ce code est qu'il élimine les doublons et trie automatiquement la liste et alimente ensuite directement le contrôle sans passer par une feuille de travail. Voici le code :

'Pour alimenter directement le ComboBoxNomEmploye

Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item

'Emplacement de la liste des groupes
Set AllCells = Sheets('Données').Range('H3:H1000')

'The next statement ignores the error caused
'by attempting to add a duplicate key to the collection.
'The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Format(Cell.Value, 'yyyy/mm/dd'), CStr(Cell.Value)
'Note: the 2nd argument (key) for the Add method must be a string
Next Cell

'Resume normal error handling
On Error GoTo 0

'Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

'Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
ComboBoxNomEmploye.AddItem Item
Next Item

Au lieu d'alimenter un combobox ou un listbox, serait-il possible d'alimenter les cellules d'une feuille ou chaque item de la liste s'afficherait dans la cellule A1, A2 ... etc ???

Merci de votre aide !
 
B

Benlo

Guest
Bonjour,

En fouillant sur le forum, j'ai trouvé ce bout de code qui fait exactement ce que je cherche à faire :



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


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


Merci à Hervé... Encore une fois !
Et merci à tous ceux qui ont pris quelques instants de leur temps pour lire mon message et essayer de trouver une solution !!
 

Discussions similaires

Statistiques des forums

Discussions
311 723
Messages
2 081 932
Membres
101 844
dernier inscrit
pktla