Remplacer un dictionnaire par un tableau

Bonjour,

J'ai récupéré un bout de code où on utilise l'objet dictionary. Or pour mon cas j'ai besoin d'un tableau car j'ai des doublons dans mes tableaux.

Quelqu'un peut me dire comment utliser les tableaux avec les mêmes les .add, .exists et .item???

voici le code :

Sub comparer_statut()

Dim Derlig As Long

Dim T_Ref, T_source, T_comp

Dim D_uniq As Object

Dim Idx As Long, Cptr As Long, NbColonne As Long, Cptr2 As Long

'------initialsations

'Application.ScreenUpdating = False

Rows(3 & ":" & Cells.Rows.Count).Hidden = False

With Range("M3:X" & Cells.Rows.Count)

.ClearContents

.Interior.ColorIndex = xlNone

End With

'mémorise les données en mémoire ram

Derlig = Columns("A").Find("*", , , , , xlPrevious).Row

T_Ref = Range("A3:E" & Derlig)

Derlig = Columns("G").Find("*", , , , , xlPrevious).Row

T_source = Range("G3:K" & Derlig)

ReDim T_comp(5, 1)

Set D_uniq = CreateObject("scripting.dictionary")

'-----remplissage du tableau de comparaison

'références

For Idx = 1 To UBound(T_Ref)

Cptr = Cptr + 1

For Cptr2 = 1 To 5

ReDim Preserve T_comp(5, Cptr)

D_uniq.Add T_Ref(Idx, Cptr2), Cptr2

T_comp(Cptr2, Cptr) = T_Ref(Idx, Cptr2)

Next

Next

'source

For Idx = 1 To UBound(T_source)

If Not D_uniq.exists(T_source(Idx, 5)) Then

Cptr = Cptr + 1

For Cptr2 = 1 To 5

ReDim Preserve T_comp(5, Cptr)

D_uniq.Add T_source(Idx, Cptr2), Cptr2

T_comp(Cptr2, Cptr) = T_source(Idx, Cptr2)

Next

Else

T_comp(5, D_uniq.Item(T_source(Idx, Cptr))) = T_source(Idx, Cptr)

End If

Next

J'explique si certains ne comprennent pas.

J'utlilise l'objet D_uniq comme dictionnaire dans lequel je viens rangé des données mais cela ne marche pas car j'ai des données qui se répéte dans mes tableaux.

Je voudrais trouver l'équivalent du dictionnaire, j'ai vu qu'avec un array on pouvais le faire.

Est ce qu'un saurait faire?

Bonjour,

voici un code qui remplace le dictionary par un array, j'ai enlevé les instructions qui traitaient du cas des doublons.

mais j'ai du mal à saisir l'objectif de cet exercice ...

Sub comparer_statut()
    Dim Derlig As Long
    Dim T_Ref, T_source, T_comp
    Dim D_uniq
    Dim Idx As Long, Cptr As Long, NbColonne As Long, Cptr2 As Long

    '------initialsations
    'Application.ScreenUpdating = False
    Rows(3 & ":" & Cells.Rows.Count).Hidden = False
    With Range("M3:X" & Cells.Rows.Count)
        .ClearContents
        .Interior.ColorIndex = xlNone
    End With
    cu = 1
    'mémorise les données en mémoire ram
    Derlig = Columns("A").Find("*", , , , , xlPrevious).Row
    T_Ref = Range("A3:E" & Derlig)
    Derlig = Columns("G").Find("*", , , , , xlPrevious).Row
    T_source = Range("G3:K" & Derlig)
    ReDim T_comp(5, 1)
    ReDim D_uniq(5, 2, cu)

    For Idx = 1 To UBound(T_Ref)
        Cptr = Cptr + 1
        cu = cu + 1
        For Cptr2 = 1 To 5
            ReDim Preserve T_comp(5, Cptr)
            ReDim Preserve D_uniq(5, 2, cu)
            D_uniq(Cptr2, 1, cu) = T_Ref(Idx, Cptr2)
            D_uniq(Cptr2, 2, cu) = Cptr2
            T_comp(Cptr2, Cptr) = T_Ref(Idx, Cptr2)
        Next
    Next

    'source
    For Idx = 1 To UBound(T_source)
        cu = cu + 1
        Cptr = Cptr + 1
        For Cptr2 = 1 To 5
            ReDim Preserve T_comp(5, Cptr)
            ReDim Preserve D_uniq(5, 2, cu)
            D_uniq(Cptr2, 1, cu) = T_source(Idx, Cptr2)
            D_uniq(Cptr2, 2, cu) = Cptr2
            T_comp(Cptr2, Cptr) = T_source(Idx, Cptr2)
        Next
    Next
End Sub

Re,

Voici ce que j'essai de faire, je veux comparer des données.

En utilisant le ''Set D_uniq = CreateObject("scripting.dictionary")'', mon code plante si j'utlise des données identiques.

Ici par exemple, si j'utilise dans la colonne E, une même information pour la référence 1 et 3, j'ai un plantage!

Donc je réfléchis à utliser autre chose. D'où utiliser un array.

J'ai essayé de remplacer par un tableau comme ds ton exemple mais ca reproduit pas ce que je faisais avec le dictionnaire!

A+

Bonjour

Et si tu testerais l'existence de la clé

          For Idx = 1 To UBound(T_Ref)
                Cptr = Cptr + 1
                For Cptr2 = 1 To 5
                    ReDim Preserve T_comp(6, Cptr)
                    If Not D_uniq.exists(T_Ref(Idx, Cptr2)) Then
                      D_uniq.Add T_Ref(Idx, Cptr2), Cptr2
                    End If
                   ' MsgBox T_Ref(Idx, Cptr2)
                    T_comp(Cptr2, Cptr) = T_Ref(Idx, Cptr2)
                Next
          Next

Re,

J'ai fait le test et cela marche!

Comme tu as pu le voir, ce sujet ressemble étroitement au sujet "comparaison xBDD".

C'est un peu différent mais l'idée est la même mais là je suis confronté à un problème.

Je veux gérer plusieurs status, ajouter autant de status que j'ai dans ma liste déroulante en cellule "K2".

En cliquant par exemple sur C, cela me créer automatiquement dans l'extract comparé en "S2" la colonne C.

Mnt je veux que la comparaison que je fais entre A et C soit renseigner dans l'extract comparé en C.

Tu aurais une idée de comment faire!

Merci,

Et les valeurs de la liste déroulante sont des exemples. Je peux avoir 1,2,3 etc à la place de A,B et C.

A+

Bonjour

Ah je n'ai rien compris

surtout

ilil a écrit :

ce sujet ressemble étroitement au sujet "comparaison xBDD".

C'est un peu différent

Sinon à mon avis tu clos ce post et tu en ouvres un autre

Tu joins un fichier en y expliquant ce que tu as et ce que du dois trouver (fais des exemples)

OKi!