XL 2010 Passer de Dico à Array avec Split

[cp4]

Bonsoir,

J'ai eu beau chercher je ne suis pas parvenu à trouver une réponse.
J'ai utilisé un dictionnaire pour faire la somme pour chaque personne (nom, prénom dans les colonnes différentes).
Jusque là, pas de problème. Maintenant, je voudrais repasser vers un autre tableau pour séparer les noms, prénoms et le montants.
Je crois savoir que la fonction split est tout indiquée à mon problème. Mais, j'avoue que je suis perdu.

For i = 1 To UBound(Tb)
d(Tb(i, 2) & "|" & Tb(i, 3)) = d(Tb(i, 2) & "|" & Tb(i, 3)) + Tb(i, 16)
Next i

En vous remerciant par avance.

 

[mapomme]

Re @laurent950 ,

J'ai du mal à comprendre ce que tu cherches.
Je ne vois pas du tout ce que tu désigne par "position de l'item" ???

A la rigueur, la position de la clef.

A mon avis, utiliser un dictionary, c'est justement se passer de la notion de position des clefs puisque l'accès se fait au moyen d'une clef textuelle (éviter les clefs numérique).

 

[patricktoulon]

bonsoir a tous
bonsoir @mapomme

un 2d dico
dico2(clef)=dico2(cleft) &" "& i

il a son tableau d'index dans les items sous forme de chaîne et c'est tout

 

[mapomme]

Bonsoir @patricktoulon

il a son tableau d'index dans les items sous forme de chaîne et c'est tout

Pas compris à quoi ça peut servir.

Donc on prend une clef. Et pour cette clef, on veut la liste des numéros de ligne ayant cette clef ?

 

[patricktoulon]

oui c'est ça
autofilter sur 2 colonnes quoi

 

[mapomme]

en fait il y a bien une limite mais celle ci dépend aussi de la mémoire alloué déjà utilisée
autrement dit on ne peut pas savoir en fait

J'ai fait des tests avec ton code. J'arrive à des limites un peu plus hautes mais limites quand même.
ça dépent aussi du type des tableaux. Un variant (je crois) occupe 8 octets un byte 1 octet. J'ai testé la limite variant est inférieure à la limite byte.

Donc ta conclusion est bonne : moi, je ne sais pas, je ne sais plus.

 

[patricktoulon]

re
oui j'ai fait plein de tests avant bien sur

donc méfie!! si travail sur grande base de donnée on peut pas prévoir tout du moins dans une limite à moins d’être devin
c'est pas parfait tout ça hein !!!!

moi, je ne sais pas, je ne sais plus.

fait comme l'oiseau

 

[patricktoulon]

@mapomme, @patricktoulon
en Poste #63
Si je remplie une variable tableau alors
t(1) = Toto-6467|Titi-6467 (Doublon trouvé avec Exists) Donc Item 1
t(2) = Toto-5095|Titi-5095 Ce n'est pas un doublon c'est Item 2

C'est se que je cherche à faire

dico2(clef)=dico2(clef)&" " & i DANS LES DEUX !!!!!!!!!( le if exists et le else )

 

[patricktoulon]

je crois que j'avais pas compris tu veux les uniques et le premier des doublons c'est ça

 

[laurent950]

Bonsoir,
un autre essaie :

Sub essaiLaurent950_Test2()
Dim TI As Single
    TI = Timer
Dim d As New Scripting.Dictionary
    Set d = New Dictionary
    d.CompareMode = TextCompare
Dim Tb() As Variant
    Tb = Range("a1").CurrentRegion
Dim i As Double

For i = LBound(Tb) + 1 To UBound(Tb)
    If d.Exists(Tb(i, 2) & "|" & Tb(i, 3)) Then
        d(Tb(i, 2) & "|" & Tb(i, 3)) = d(Tb(i, 2) & "|" & Tb(i, 3)) + Tb(i, 16)
    Else
        d.Add Tb(i, 2) & "|" & Tb(i, 3), Tb(i, 16)
    End If
Next i

'Erase Tb

Dim tempKey() As Variant
Dim tempItem() As Variant
tempKey = d.Keys: tempItem = d.Items

'Set d = Nothing

Dim temp2() As Variant
ReDim temp2(LBound(tempKey, 1) + 1 To UBound(tempKey, 1) + 1, 1 To 3)
    
    For i = LBound(tempKey, 1) To UBound(tempKey, 1)
        temp2(i + 1, 1) = Split(tempKey(i), "|")(0)
        temp2(i + 1, 2) = Split(tempKey(i), "|")(1)
        temp2(i + 1, 3) = tempItem(i)
    Next i
    
[V1].Resize(UBound(temp2, 1), UBound(temp2, 2)) = temp2

MsgBox Format(Timer - TI, "0.000\ sec.")
End Sub

 

[Staple1600]

Bonsoir

[suggestion au passage]
Laurent950
Il serait peut-être temps d'ouvrir ta propres discussion, non ?
On est déjà à 4 pages
et l'initiateur du fil, c'était cp4.
Moi, je dis cela, je dis rien
[/suggestion au passage]

 

[Dranreb]

Bonsoir.
Il doit y avoir une erreur dans votre code parce qu'il me semble que le dernier terme du d.Add devrait être Tb(i, 16)) et non Tb(cpt + 1, 16). Ce dernier est vide n'est-ce pas, et le premier Tb(i, 16) manquera à la somme.
De toute façon je n'aurait pas du tout fait comme ça. J'aurais utilisé un seul Dictionary juste pour le numéro de ligne, et je m'en serais servi pour établir le résultat directement dans un tableau. Pas utile de stocker ces résultats dedans.
Remarque: si un objet est déclaré avec New, il est défini automatiquement lors de sa première invocation. Inutile donc de le définir ensuite par un Set, ou alors inutile de le déclarer avec New, c'est l'un ou l'autre.

 

[laurent950]

Bonsoir Draneb,
Maintenant que j'ai saisie le mode de fonctionnement effectivement avec un seul dictionnaire c'est possible :

Code

Sub essaiLaurent950_Test778suite()
Dim TI As Single
    TI = Timer
Dim d As New Scripting.Dictionary
    d.CompareMode = TextCompare
Dim Tb() As Variant
    Tb = Range("a1").CurrentRegion
Dim i, cpt As Double
Dim x As Variant
' ****************************************************************************************************
    For i = LBound(Tb) + 1 To UBound(Tb)
        If d.Exists(Tb(i, 2) & "|" & Tb(i, 3)) Then
            x = d(Tb(i, 2) & "|" & Tb(i, 3))
            d(Tb(i, 2) & "|" & Tb(i, 3)) = Array(Tb(cpt + 1, 2), Tb(cpt + 1, 3), Tb(x(3), 16) + Tb(i, 16), x(3))
        Else
            cpt = d.Count + 1
            d.Add Tb(i, 2) & "|" & Tb(i, 3), Array(Tb(cpt + 1, 2), Tb(cpt + 1, 3), Tb(cpt + 1, 16), cpt + 1)
        End If
    Next i
' ****************************************************************************************************
[v1].Resize(d.Count + 1, 3) = Application.Transpose(Application.Transpose(d.Items)) ' = OK

MsgBox Format(Timer - TI, "0.000\ sec.")
End Sub

 

[Dranreb]

Moi je faisais comme ça :

Sub EssaiDranreb()
   Dim TDon(), LDon As Long, TRés(), LRés As Long, Clé As String, Dic As New dictionary
   TDon = ActiveSheet.[A1].CurrentRegion.Value
   ReDim TRés(1 To UBound(TDon, 1), 1 To 3)
   For LDon = 1 To UBound(TDon, 1)
      Clé = TDon(LDon, 2) & "|" & TDon(LDon, 3)
      If Dic.exists(Clé) Then
         LRés = Dic(Clé)
         TRés(LRés, 3) = TRés(LRés, 3) + TDon(LDon, 16)
      Else
         LRés = Dic.Count + 1: Dic(Clé) = LRés
         TRés(LRés, 1) = TDon(LDon, 2)
         TRés(LRés, 2) = TDon(LDon, 3)
         TRés(LRés, 3) = TDon(LDon, 16)
         End If
      Next LDon
   ActiveSheet.[V1].Resize(Dic.Count, 3) = TRés
   End Sub

 

[patricktoulon]

re
bonjour a tous
pauvre cp4 qui viendrait chercher réponse a son questionnement
laurent tu a cette fâcheuse habitude de partir en vrille dans un flot d'essais si bien que la fin finalement on sait même pas de quoi tu parle
que tu participe et apporte tes pierres a l’édifice je comprends mais que tu consacre 2 dernière page de ce posts pour tes essais non là ça passe pas
d'autant plus que c'est pas vraiment le sujet de cp4 que tu traite ça en est un autre

d'autant plus que a chaque fois tu nous pond des codes de fou interminables et là on en a encore une exemple d'autres te proposent comme ici @Dranreb et comme je l'ai fait dans le passé et toi tu continue a pondre des truc de fous
a croire que tu n’écoute pas !!!!perso je trouve ça irritant ça me pique un peu les yeux si tu vois ce que je veux dire

qu'est ce que ça te coûte d'ouvrir ton post quitte a citer celui là en exemple

malheureux et bien courageux est celui qui viendrait chercher une solution ici
ma participation s’arrête là ce post a été est assez pourri comme ça

je précise quand même que la solution a été apporté par @mapomme (rendons a César ce qui est a César)et que j'ai accéléré en supprimant les deux boucle de reconstruction en utilisant un tableau transposé

 

[laurent950]

Bonjour @patricktoulon
Je remercie @mapomme qui a apporté la solution finale à ce fil, Merci à @patricktoulon pour sa contribution très constructive aussi sur la méthodologie des codes crées au fil des solutions... et aussi tous les autres.
@cp4 Beaucoup de solution s'offre à vous avec ce fil riche en code et possibilité avec L'objet
dictionary

Cdt