J'ai un fichier avec une colonne avec différentes valeurs (ex 50 000 valeurs mais x valeurs différentes x=1 à 100 par exemple).
J'aimerais avoir une macro qui me liste les x valeurs possibles dans un tableau.
Il faudrait que le résultat soit quasi immédiat un peu comme le fait le filtre automatique.
en gros je voudrais le résultat de l'ensemble des valeurs du filtre automatique dans un tableau....sans avoir à utiliser le filtre automatique.
Sur une liste de 50000 valeurs j'ai de très serieux doutes quant à un resultat immediat
Je ne te propose pas ce que j'ai conçu parce que dans ces eaux la il faut environ 50 secondes pour sortir un resultat
D'ailleurs les tests que j'ai fait avec le filtre automatique ne permettent pas d'avoir l'integralité des valeurs distinctes ( le filtre s'arrete a 1018 pour plus de 20000 valeurs)
Si tu peux t'accomoder d'un delai de 5 secondes environ pour 50000 lignes teste le code suivant (colonne A resultat en colonne C)
Code:
Sub test()
debut = Timer
Application.ScreenUpdating = False
Dim coll As Collection
Set coll = New Collection
Dim tableau()
Set tablo = Range("A1:A" & Range("A65536").End(xlUp).Row)
For Each cel In tablo
On Error Resume Next
coll.Add cel.Value, CStr(cel.Value)
If Err.Number = 0 Then
ReDim Preserve tableau(1 To coll.Count)
tableau(coll.Count) = cel.Value
End If
On Error GoTo 0
Next cel
For n = LBound(tableau) To UBound(tableau)
Range("C" & n) = tableau(n)
Next n
Application.ScreenUpdating = True
MsgBox (Timer - debut)
End Sub
Ps: J'ai cherché en vain la methode pour affecter un tableau a une plage autrement que par une boucle
Si quelqu'un la connait , merci de me la communiquer
Si tu peux t'accomoder d'un delai de 5 secondes environ pour 50000 lignes teste le code suivant (colonne A resultat en colonne C)
Code:
Sub test()
debut = Timer
Application.ScreenUpdating = False
Dim coll As Collection
Set coll = New Collection
Dim tableau()
Set tablo = Range("A1:A" & Range("A65536").End(xlUp).Row)
For Each cel In tablo
On Error Resume Next
coll.Add cel.Value, CStr(cel.Value)
If Err.Number = 0 Then
ReDim Preserve tableau(1 To coll.Count)
tableau(coll.Count) = cel.Value
End If
On Error GoTo 0
Next cel
For n = LBound(tableau) To UBound(tableau)
Range("C" & n) = tableau(n)
Next n
Application.ScreenUpdating = True
MsgBox (Timer - debut)
End Sub
Ps: J'ai cherché en vain la methode pour affecter un tableau a une plage autrement que par une boucle
Si quelqu'un la connait , merci de me la communiquer
merci pierrejean...
j'ai procédé différemment sans me servir des collections (que je ne connais pas) mais ton programme doit être beaucoup plus rapide que le mien, mais tant que ca dure pas plus de 1 minute ca me gêne pas finalement
t = Timer
b = [a1:A50000].Value
Set mondico = CreateObject("Scripting.Dictionary")
For i = 1 To 50000
If Not mondico.Exists(b(i, 1)) Then mondico.Add b(i, 1), b(i, 1)
Next i
[D1].Resize(mondico.Count) = Application.Transpose(mondico.items)
MsgBox Timer() - t
>Ps: J'ai cherché en vain la méthode pour affecter un tableau à une plage autrement que par une boucle.Si quelqu'un la connaît , merci de me la communiquer
b = [a1:A50000].Value ' copie A1:A50000 dans tableau b(1 To 50000, 1 To 1)
Le transfert est beaucoup + rapide qu'avec une boucle.
Dim a(1 To 3)
a(1) = 56
a(2) = 33
a(3) = 77
[A1:A3] = Application.Transpose(a)
t = Timer
b = [a1:A50000].Value
Set mondico = CreateObject("Scripting.Dictionary")
For i = 1 To 50000
If Not mondico.Exists(b(i, 1)) Then mondico.Add b(i, 1), b(i, 1)
Next i
[D1].Resize(mondico.Count) = Application.Transpose(mondico.items)
MsgBox Timer() - t
il y ait une limite (peut-etre due a mondico.count)
Avec il est vrai très peu de doublons, je tombe sur un bugg avec
Code:
Sub test1()
t = Timer
b = [a1:A6000].Value
Set mondico = CreateObject("Scripting.Dictionary")
For i = 1 To 6000
If Not mondico.Exists(b(i, 1)) Then mondico.Add b(i, 1), b(i, 1)
Next i
MsgBox (mondico.Count)
[D1].Resize(mondico.Count) = Application.Transpose(mondico.items)
MsgBox Timer() - t
End Sub
Edit: Je n'avais pas vu ta reponse
Merci beaucoup , cela eclaire ma lanterne (dont la lueur commence serieusement à faiblir)