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 :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 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
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??
Partager