Création d'une liste

Bichkek

XLDnaute Junior
Bonjour à tous,

Je vous explique mon problème. Je chercher à automatiser la création d'une liste (dans la colonne R) via des données inscrites dans une colonne (colonne B).

J'aimerais avoir à partir de R3 "A" puis en R4 "B",… pas forcément par ordre alphabétique mais avoir une liste sans doublon.

J'ai essayé de créer un filtre mais il ne fonctionne pas (pour info je suis sur excel 2003).

Autre information importante, le tableau n'est pas encore fini. De nouvelles lignes peuvent être compmlétées après la ligne 69. Toutefois, le tableau ne devrait pas s'étendre au-delà de la ligne 1000.

Pensez-vous que se soit possible? Vous pouvez passer par VBA si c'est plus simple. Si je n'ai pas été assez clair, n'hésitez pas.

Merci par avance de votre aide.
 

Pièces jointes

  • Exemple.xls
    153.5 KB · Affichages: 44
  • Exemple.xls
    153.5 KB · Affichages: 46
  • Exemple.xls
    153.5 KB · Affichages: 43

Robert

XLDnaute Barbatruc
Repose en paix
Re : Création d'une liste

Bonjour Bichkek, Patrick, bonjour le forum,

En pièce jointe ton fichier modifié avec la macro événementielle Change ci-dessous :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim d As Object 'déclare la variable d (Dictionnaire)
Dim cel As Range 'déclare la variable cel (CELlule)

If Target.Column <> 2 And Target.Row = 1 Then Exit Sub 'si le changement a lieu ailleurs que dans la colonne B ou dans la ligne 1, sort de la procédure
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
dl = Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 2 (=B)
Set pl = Range("B2:B" & dl) 'définit la plage pl
Set d = CreateObject("Scripting.Dictionary") 'définit le dictionnaire d
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    If cel.Value <> "" Then d(cel.Value) = "" 'si la cellule n'est aps vide alimente le dictionnaire d
Next cel 'prochaine celllule de la boucle
Range("R3").Resize(d.Count) = Application.Transpose(d.keys) 'place en R3 le dictionnaire sans doublon
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
Le fichier :
 

Pièces jointes

  • Bichkek_v01.xls
    149.5 KB · Affichages: 44

Robert

XLDnaute Barbatruc
Repose en paix
Re : Création d'une liste

Bonjour Bichek, bonjour le forum,

Je pensais résoudre le problème avec les lignes :
Code:
Application ScreeUpdating = False
'...
Application ScreeUpdating = True
Mais visiblement ça suffit pas et je ne vois pas comment faire autrement...
 

Discussions similaires

Statistiques des forums

Discussions
312 609
Messages
2 090 194
Membres
104 449
dernier inscrit
Miguel937