XL 2013 CreateObject("scripting.dictionary") et/ou variable tableau ?

[BenHarber]

Bonjour le Forum,
J'ai trouvé la fonction VBA suivante sur développez.net (merci Mchel M) qui me permet de compter sans doublon les enregistrements d'une plage de cellules. Elle fonctionne bien (même si je ne vois pas trop à quoi CreateObject("scripting.dictionary") correspond...)

A présent, je souhaiterais utiliser les différentes valeurs trouvées dans cette plage de cellules. Je pensais pour cela les enregistrer dans une variable tableau [du type : monTab(0 à n)] : ma question est de savoir si je peux pour cela utiliser "dico" (?) ou si je dois obligatoirement créer une nouvelle variable tableau ?
Merci d'avance pour vos idées toujours constructives !
BH
Function compter_uniques(plage As Range) As Long

Set dico = CreateObject("scripting.dictionary")
For Each cellule In plage
ref = cellule.Value
If Not dico.exists(ref) Then
dico.Add ref, ref
End If
Next
compter_uniques = dico.Count
End Function

 

[jmfmarques]

j'ignore comment le code que tu montres-là a pu te permettre de comparer quoi que ce soit. J'ignore également si tu l'as vraiment testé (tu aurais eu un beau message d'erreur ...)
Une chose est certaine : nous n'avons très manifestement pas la même manière d'aborder les erreurs éventuelles, ni celle d'éviter l'ajout d'une clé existante.
Bon ...

 

[Dranreb]

De quoi mettre tout le monde d'accord ?
J'en doute ! …

 

[BOISGONTIER]

>j'ignore comment le code que tu montres-là a pu te permettre de comparer quoi que ce soit. J'ignore également si tu l'as vraiment testé (tu aurais eu un beau message d'erreur ...)

Je viens de le tester sur Excel 2002, Excel 2007, Excel 2010, Excel 2016 et Excel 2019.
Pas de message d'erreur.

>J'ignore également si tu l'as vraiment testé

Assez des insultes!

Objet dictionary

http://boisgontierjacques.free.fr/fichiers/Formulaire/FormFonctionListeSansDoublons.xlsm

Boisgontier

 

[jmfmarques]

La même erreur qu'avec le fichier de Dranreb (et pour la même raison) sur ma machine --->>

 

[Staple1600]

Bonsoir le fil

Ici c'est le Dico qui mène la danse
(cf test tout en bas de la page)

[une once de mauvais esprit ;-)]
Heureusement que nous sommes sur un forum dédié à Excel
Parce que le dico n'a rien à voir avec Excel
(en natif je veux dire)
[/une once de mauvais esprit ;-)]

 

[jmfmarques]

 

[Staple1600]

Re

jmfmarques
Et le test dans mon précédent message?
Chez moi, il est en train de tourner.

 

[Dranreb]

Quelle est l'instruction incriminée si vous faites Débogage ?

 

[jmfmarques]

voilà pour répondre à stapple et dranreb à la fois
Avec la première manière de gérer --->> la ligne surlignée de jaune (image)

Avec cette manière (stapple) :
Dim MyCollection As New Collection
MyCollection.Add "foo", "foo"
On Error Resume Next
X = MyCollection("foo")
If Err = 0 Then
    MsgBox X & " existe déjà" ' ====>> aucun problème
Else
    Err.Clear
    MsgBox "There is no value associated with 'foo'"
End If


'MAIS : ========================
X = MyCollection("toto") ' ne passera pas -->> erreur
If Err = 0 Then
    MsgBox X & " existe déjà"
Else
    Err.Clear
    MsgBox "There is no value associated with 'toto'"
End If
On Error GoTo 0

(constats sur ma machine)
MA MACHINE : DELL Ultrabook LATITUDE E7450 - Windows 10 - Office 2007 - Toutes mises à jours à jour.

 

[Dranreb]

Et sur mon code ? (Citez l'instruction, on ne voit rien sur vos images)

 

[Dranreb]

Ah, il est possible que les On Error Resume Next soit sans effet. C'est le cas si dans VBE, menu Outils, sous-menu Options…, onglet Général, rubrique Récupération d'erreurs c'est l'option"Arrêt sur toutes les erreurs" qui est cochée.

 

[Staple1600]

Re

=>jmfmarques
Décidément c'est pas mon jour
C'est point stapple mais Staple
Même si c'est absent du dico

Quand au code, je n'en ai commis aucun dans ce fil
J'ai juste posté une URL

 

[jmfmarques]

C'est point stapple mais Staple

Pas mon jour non plus, apparemment. Et me voilà de toutes manières agrafé.
(les 2P en raison probablement d'une déformation nord-américaine et/ou australienne de la bonne orthographe)
Amitiés et Mille Excuses.

 

[Staple1600]

Re

Mon pseudo vient d'ici

PS: J'ai testé ton code (et j'ai une erreur)

Mais apparemment personne n'a testé le code présent sur la page du site que j'ai précédemment cité.
(on peut faire le test sans devoir télécharger un classeur tiers )

 

[mapomme]

Bonsoir à tous

Bon, j'y vas aussi de mon essai, sans dictionary (j'aime les MACistes), sans collection ( j'aime pas les défilés) avec un tableau t final qui contient les doublons (triés). La durée d'exécution est moyenne (pour 200 000 éléments au départ et 11 111 env. à la fin).
Le code est dans le module de Feuil1. Init! remplit la colonne A. Hop! lance la macro.

En tout cas, je ne revendique pas d'avoir ni la plus courte ni la plus longue (en durée d'exécution, cela va de soi ).

Sub test()
Dim ncolaux&, nLig&, derlig&, t, deb
   On Error GoTo Suppr
   Range("b2").Resize(Rows.Count - 1).ClearContents
   deb = Timer
   Application.ScreenUpdating = False
   ncolaux = Me.UsedRange.Column + Me.UsedRange.Columns.Count
   nLig = Cells(Rows.Count, "a").End(xlUp).Row - 1
   Cells(1, ncolaux).Resize(nLig).Value = Range("a2").Resize(nLig).Value
   Cells(1, ncolaux).Resize(nLig).RemoveDuplicates Columns:=1, Header:=xlNo
   derlig = Cells(Rows.Count, ncolaux).End(xlUp).Row
   Columns(ncolaux).Resize(derlig).Sort key1:=Cells(1, ncolaux), order1:=xlAscending, Header:=xlNo, MatchCase:=False
   t = Columns(ncolaux).Resize(derlig)
   Range("b2").Resize(derlig) = t
   Columns(ncolaux).Delete
   MsgBox "durée =  " & Format(Timer - deb, "0.00\ sec."), vbInformation
   Exit Sub
Suppr:
   If ncolaux > 0 Then Columns(ncolaux).Delete
   MsgBox "Une erreur est survenue", vbCritical
End Sub