Bonsoir le forum

Encore besoin de votre aide :

J' ai réalisé un tri dans une base de données. J'extrais les ligne obtenues dans une nouvelle feuille qui me fera plusieurs calculs.
Dans la colonne A, j'ai les essences qui peuvent être les mêmes sur plusieurs lignes et changer (exemple a,b,c,c,c,a,b,g,g,g,h,t,a,a,)

de cette liste de valeur, je voudrais extraire une liste sans doublons et triée (à coller en Y3) de la feuille lotissement

J'ai essayé à partir de deux méthodes différentes mais j'obtiens avec Sub sans doublons trié 1 une liste avec doublon (toutes les essences sont là
Mon code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub lotissement()
 
Dim dl As Long
'selection de la feuille "BD"; determination de laderniere ligne
With Sheets("BD")
    dl = .Range("C" & .Rows.Count).End(xlUp).Row
 
 
'Selectionne la plage filtrée et le copie vers la feuille "lotissement"
    .Range("C1:R" & dl).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("lotissement").Range("A11")
End With
Call SansDoublonsTrié1
End Sub
Sub SansDoublonsTrié1()
  Dim temp()
  Set f = Sheets("lotissement")
  Set mondico = CreateObject("Scripting.Dictionary")
  a = Range(f.[a12], f.[a65000].End(xlUp)).Value
  For Each c In a
     mondico(c) = ""
  Next c
  Set dest = f.Range("Y3")
  dest.Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
  dest.Resize(mondico.Count, 1).Sort Key1:=dest, Order1:=xlAscending
  Set mondico = Nothing ' libère mondico
End Sub
et avec lautre code sub listeessence, j'obtiens une liste incomplete

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub liste_essence()
    Dim Cell As Range
    Dim Tableau()
    Dim TempTab As Variant
    Dim i As Integer, j As Integer
    Dim boolVerif As Boolean
 
    ReDim Tableau(2 To 2)
    Tableau(2) = Cells(2, 16)
 
    'Boucle sur les données de la colonne P, dans la BD
    For Each Cell In Worksheets("lotissement").Range("A12:A" & _
                        Worksheets("lotissement").Range("A65536").End(xlUp).Row)
        boolVerif = False
 
        'Vérifie si le contenu de la cellule existe déjà dans le tableau
        For i = 2 To UBound(Tableau)
            'Si la donnée existe déjà dans le tableau
            If Tableau(i) = Cell Then
                boolVerif = True
                Exit For
            End If
        Next i
 
        'Si la donnée n'existe pas dans le tableau, on augmente la taille du tableau
        'et on ajoute la donnée.
        If boolVerif = False Then
            ReDim Preserve Tableau(2 To UBound(Tableau) + 1)
            Tableau(UBound(Tableau)) = Cell
        End If
 
        'Tri le contenu du tableau par ordre croissant.
        For i = 2 To UBound(Tableau)
            For j = 2 To UBound(Tableau)
                If Tableau(i) < Tableau(j) Then
                    TempTab = Tableau(i)
                    Tableau(i) = Tableau(j)
                    Tableau(j) = TempTab
                End If
            Next j
        Next i
    Next Cell
 
   'copie du tableau en Y3
 Sheets("lotissement").Range(Cells(3, 25), Cells(UBound(Tableau), 25)).Value = Application.WorksheetFunction.Transpose(Tableau)
 
End Sub

pouvez vous m'aider??