Discussion :

[Daranc]

Bonjour
actuellement je me sers d'un fichier excel d'où je tire une liste de fournisseur d'un tableau général de non conformité par formule (un exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=INDEX(INDIRECT(CONCATENER("b1:b";NBVAL(A:A)+14));MIN(SI(NB.SI(AN$15:AN17;INDIRECT(CONCATENER("b16:b";NBVAL(A:A)+14)))=0;SI(INDIRECT(CONCATENER("b16:b";NBVAL(A:A)+14))<>"";LIGNE(INDIRECT(CONCATENER("b16:b";NBVAL(A:A)+14)))))))&"""

ceci couvre un certain nombre de lignes et d'autre formules du même tonneau sont alignées en colonne pour des extractions par date .Pendant deux ans ça à fonctionner (là encore ça tourne mais avec un sérieux ralenti)
Ce que je cherche c'est d'extraire de ma colonne B un tableau sans doublon par VBA et franchement ces telmps ci je n'arrive pas à connecter la méthode de tri pour ne pas incrémenter mon tableau sur un doublon
pour l'instant j'en suis là

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub fournisseurs()
Dim t As Integer
Dim fourn() As Variant
fin = Range("b65535").End(xlUp).Row
For t = 16 To fin
fourn(t) = Cells(t, 2).Value
Next
End Sub

on peut pas dire que j'ai beaucoup avancé

[peaceandloveman01]

bonjour,

j'ai développez rapidement ce petit bout de programme qui fonctionne. En fait j'incrémente une liste dans laquelle je place les données à extraire. Pour chaque nouvelle donnée, je vérifie sa présence dans la liste. Si elle l'est je passe à la donnée suivante...

(Je ne pense pas être très clair... )

Clique sur le bouton et tu verras apparaitre la liste de la colonne A sans doublons !

Si tu as des questions sur le code n'hésite pas !!

Cordialement,

Lyonel

[neupont]

Et une collection ?
C'est pas mal une collection pour ça, j'ai d'ailleurs appris ça ici il n'y a pas très longtemps.

Je mets un exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Dim maCollection As New Collection
 
'Entrée des données dans la collection :
For t = 14 To Cells(Rows.Count, 1).End(xlUp).Row
    On Error Resume Next 'indispensable pour ne pas bloquer sur les doublons
    maCollection.Add Cells(t, 2), CStr(Cells(t, 2))
Next
 
'Exemple de récupération des données de la collection :
For i = 1 To maCollection.Count
    Sheets("UneAutreFeuille").Cells(i, 1) = maCollection.Item(i)
Next

L'intérêt c'est que la clé d'une collection ne peut évidemment pas être un doublon, donc à la fin tu te retrouves avec une liste de valeurs uniques.

[Montor]

pour gagner du temps

neupont

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
ReDim cache(maCollection.Count - 1, 0): j = 0
For Each elem In maCollection
cache(j, 0) = elem: j = j + 1
Next: ListBox1.list = cache

[Daranc]

J'ai commencé par le code de Lyonel
j'ai un peu accélérer son exemple avec transpose
il faut que je voies ce que ça donne dans mon fichier

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
Private Sub CommandButton1_Click() 'code Lyonel
Dim tableau() As String
 
ReDim tableau(1)
For i = 1 To 20
    tailletableau = UBound(tableau, 1)
    For k = 1 To tailletableau
    If tableau(k) = Cells(i, 1) Then
    GoTo line1
    End If
    Next k
    tableau(tailletableau) = Cells(i, 1)
    ReDim Preserve tableau(tailletableau + 1)
line1:
Next i
'ceci accélère la pose
Range("b1:b" & UBound(tableau, 1)) = WorksheetFunction.Transpose(tableau)
End Sub

maintenant la collection ça à l'air intéressant mais c'est relativement long . apparament la collection doit être créée par la macro lors de son lancement (à chaque redémarrage du fichier ) c'est le temps d'intervention qui me fait chercher une solution VBA
delphidelphi je n'ai pas trouver ou placer ton code par contre le terme Listbox me fait penser que je vais peut être passer par un USF. J'ai des programmes sur gros fichier qui font des tri et des listes de façon rapide, enfin nettement plus que celui là)
Merci

[neupont]

Ne peux-tu pas trier ta feuille selon la colonne B ? Ainsi les doublons se suivent, en une seule boucle tu remplis ton tableau en vérifiant simplement que chaque cellule (nouvelle ligne, colonne B) n'est pas identique à celle de la ligne du dessus.

[Daranc]

hélas non cette feuille est une feuille d'un tableau et (l'instrument de rasage qui s'en sert est allergique à tout travail) le tableau est ordonnée par date .la date est toujours le premier critère de choix le fournisseur n'est sélectionné que pour des pratiques de coercitions à son égard Actuellement en combinant les codes avec mes propre développements j'arrive çà quelque chose qui commence à prendre tournure
Merci

[Daranc]

finalement non je tourne en rond
je crée très rapidement le premier tableau en mémoire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub createliste()
Dim tableau() As Variant
Dim i As Integer
 
Sheets("NC_FOURNISSEUR").Select
 
'**********************************************
'*constitution du tableau la liste fournisseur*
'**********************************************
fin = Range("b65535").End(xlUp).Row
For i = 0 To fin
ReDim Preserve tableau(i)
tableau(i) = Cells(i + 16, 2)
Next

ceci me fait un tableau avant même de claquer les doigts
mais après faire une extraction de valeur unique de ce tableau me fait tourner en bourrique : soit j'ai un tableau vide soit j'ai une erreur d'indice soit enfin j'ai un tableau de même dimension que le premier avec (dans ce cas 247 fois la même valeur) (ha j'ai oublié le cas ou seul le premier doublon avait sauté)
si quelqu'un a la solution sur que je rechercherais le ticket de metro de l'année de mon Bacc ( un collector) . mais sans rire je suis en train de ressembler à Kojak (y a des cheveux partout sur mon bureau

[fring]

Bonjour,

As-tu essayé la solution de Neupont ? Une collection c'est l'idéal pour extraire ta liste sans doublon

[Montor]

voici une fonction tres rapide creee initialement pour gerer plusieurs combobox master slave
elle est dans une uersform

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
 
Private Sub CommandButton1_Click()
Dim oCollection As New Collection, stmps As String
Dim j, sRow, zt, tp, paramid, b, Refs As Long, elements, elem As Variant
zt = Timer
sRow = Range("A" & Rows.Count).End(xlUp).Row
Refs = 100
ReDim tableau(Refs)
For b = 0 To sRow Step Refs
tableau = Range("A1:A" & Refs).Offset(b, 0).Value
For Each elem In tableau
If elem <> "" Then
On Error Resume Next
oCollection.Add elem, CStr(elem)
Err.Clear
End If
Next
Next
If oCollection.Count > 0 Then
ReDim ss(oCollection.Count - 1, 0): j = 0
For Each elem In oCollection
ss(j, 0) = elem: j = j + 1
Next
ListBox1.List = ss
MsgBox j & " element en : " & Timer - zt & " s"
End If
End Sub

exemple voir le fichier

[Montor]

ramplacer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
ListBox1.List = ss

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Range("b1:b" & j) = ss

et elle sera ideal

[fring]

Delphi,

Pour info, lorsque tu déclares tes variables, chaque variable doit être typée sinon elle sera de type Variant par défaut.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim a, b, c As Integer '--> a de type Variant, b de type Variant et c de type Integer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim j As Long, sRow As Long, zt As Long, tp As Long, paramid As Long, b As Long, Refs As Long, elements, elem

[Daranc]

Bonjour,

As-tu essayé la solution de Neupont ? Une collection c'est l'idéal pour extraire ta liste sans doublon

oui mais le temps de creation est long et c'est ce que je veux ameliorer
fring
pour les déclarations de variable c'est bien une des rares chose que je connais , c'est pourquoi je déclare toujours mes variables 1 par ligne, (enfin quand je les déclare)
ce que je tente c'est d'extraire les doublons du tableau en mémoire. la création de ce tableau étant quasi instantanée l'extration ne devrait pas être beaucoup plus longue (pas en temps machine mais en seconde) par contre je bloque sévère la dessus
bon ne chercher plus j'ai trouvé

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
Sub createliste()
Dim tableau() As Variant
Dim i As Integer
Dim tablo() As Variant
Sheets("NC_FOURNISSEUR").Select
 
'**********************************************
'*constitution du tableau la liste fournisseur*
'**********************************************
fin = Range("b65535").End(xlUp).Row
For i = 0 To fin
ReDim Preserve tableau(i)
tableau(i) = Cells(i + 16, 2)
Next
u = o
For t = 0 To fin
For j = 0 To u
ReDim Preserve tablo(u)
If tableau(t) = tablo(j) Then
k = k + 1
End If
Next
If k < 1 Then
tablo(u) = tableau(t)
u = u + 1
Else
k = 0
End If
Next
End Su

c'est instantané
la solution ne venait pas car je me gourrais dan mes variables
finalement il faut que je me force au Option explicit

[ouskel'n'or]

Tu as une réponse plus courte et toute neuve ici
Désolé de venir si tard

[zazaraignée]

En effet, la FAQ donne quelques solutions. En plus de celle proposée par Ouskel'n'or, il y a aussi quelques rubriques de cette FAQ dédiées à la gestion des doublons.

[Daranc]

Tu as une réponse plus courte et toute neuve ici
Désolé de venir si tard

Je ne vois pas trop ce que ça apporte ?-!-? j'obtiens la fenêtre ci-dessous
Pour Alain Tech effectivement l'oubli est réparé
pour le délai de réponse excusez-moi j'étais enfoui dans divers sujets et codes entre autre réparations ,mesure et redaction de rapport
Cordialement
Daranc

[ouskel'n'or]

Je ne vois pas trop ce que ça apporte ?-!-? j'obtiens la fenêtre ci-dessous

C'est internet qui s'est mordu les genoux... J'ai vérifié le lien hier et il était bon... Je te mets donc le code, la solution proposée est plus simple que celle de la FAQ

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Dim Plage As Range, Cell As Range
    Set Plage = Range("A1:A" & Split(ActiveSheet.UsedRange.Address, "$")(4))
    Plage.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Plage, Unique:=True
    Set Plage = Plage.SpecialCells(xlCellTypeVisible)
    For Each Cell In Plage
        MsgBox Cell
    Next

Bonne journée

Edit
Lien fou corrigé (pas la première fois que ça arrive )

[Daranc]

merci
effectivement ce matin le lien marche à nouveau
j'ai souvenir d'un lien dans un classeur excel de Serge Garneau qui m' envoyé sur une page porno
le solution que tu proposes est celle que j'ai finalement employée je l'ai repiquée de l'enregistreur de macro
je te passes la réflexion sur les grands esprits? oui je la passe sous silence

par contre le code à l'air d'être nettement plus propre que ma tambouille
voici l'extrait concerné

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
'**********************************************
'*constitution du tableau la liste des clients*
'**********************************************
 
'** liste les different clients sur la periode **
With Sheets("NC_CLIENT")
fin = FinTaC - DebTaC
For i = DebTaC To FinTaC
ReDim Preserve TableauC(i - DebTaC)
TableauC(i - DebTaC) = .Cells(i, 2)
Next
End With
'*--------------------------------
With Sheets("Recap")
.Range("a:aJ").ClearContents
.Range("aj1").Value = "CLIENT"
.Range("AJ2:AJ" & fin + 2).Value = WorksheetFunction.Transpose(TableauC)
.Range("AJ12:AJ" & fin + 2).Sort Key1:=.Range("AJ2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
.Range("AJ1:AJ" & fin).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
        "AJ1:AJ" & fin), CopyToRange:=.Columns("A:A"), Unique:=True

Cordialement
G.David