Redim Preserve ne passe pas [RESOLU]

[cathodique]

Bonjour,

J'essaie d’apprendre un plus à utiliser les tableaux VBA.
J'ai donc pris un fichier de JB ci-joint. Dans lequel, on effectue la somme des produits listés en colonne en utilisant un tableau vba. Cependant, il s'avère que le tableau final à les mêmes dimensions que le tableau de départ dont la majeure des lignes est vide.

Etant donné, que l'on ne peut modifier que la dernière dimension, j'ai transposé le tableau final.
J'ai voulu reprendre que les colonnes non vides mais je n'arrive pas à redimensionner convenablement le tableau.

Merci pour votre aide.

Bonne journée.

Edit: Problème résolu, il fallait que je définisse un autre tableau et lui appliquer le Redim Preserve.

 

[cathodique]

Malgré avoir résolu mon problème. Une chose m'a dérouté dans ce code.

On utilise une variable p=d.count, cependant dans la fenêtre des variables, en stoppant le code juste à fin de la première boucle, on s'aperçoit que la variable p=90 alors que le count du dictionnaire d est de 128. Je n'ai rien compris, p=d.count -->90 et count de d -->128.
128 est le bon résultat.

Si vous avez une explication, je suis preneur pour ne pas mourir idiot.

Bonne journée.

ps: fichier du post#1 mis à jour.

 

[ChTi160]

Bonjour Cath
Bonjour le Fil , le Forum
Je n'ai pas d'explication , mais j'ai remarqué que si tu tri la plage"A:C" , cela ne se produit plus (p=128)
Bonne journée
jean marie

 

[BOISGONTIER]

Bonjour,

A l'affichage dans le tableur , on ne prend que les lignes non vides de TblS()

Sub SousTotalNonTrié()
  Set d = CreateObject("Scripting.Dictionary")
  TblE = Range("A2:C" & [a65000].End(xlUp).Row)                           ' Table entrée
  Dim TblS(): ReDim TblS(1 To UBound(TblE), 1 To UBound(TblE, 2))         ' Table sortie
  For i = LBound(TblE) To UBound(TblE)
    clé = TblE(i, 1) & "|" & TblE(i, 2)
    If d.exists(clé) Then
      lig = d(clé)                                             ' Récupération index TblS()
   Else
     d(clé) = d.Count + 1: lig = d.Count: TblS(lig, 1) = TblE(i, 1): TblS(lig, 2) = TblE(i, 2)
   End If
   For c = 3 To UBound(TblE, 2): TblS(lig, c) = TblS(lig, c) + TblE(i, c): Next c  ' Totalisation numérique
  Next i
  [E2].Resize(d.Count, UBound(TblS, 2)) = TblS     ' on ne prend que les cellules pleines de TblS()
End Sub

Boisgontier

 

[job75]

Bonjour cathodique, Jean-Marie, JB, le forum,

C'est pourtant simple, p n'est pas toujours égal à d.Count !

If d.exists(TblE(i, 1)) Then
p = d(TblE(i, 1)) ' Récupération index dans p
Else
d(TblE(i, 1)) = d.Count + 1: p = d.Count

Bonne journée.

 

[cathodique]

Bonjour Cath
Bonjour le Fil , le Forum
Je n'ai pas d'explication , mais j'ai remarqué que si tu tri la plage"A:C" , cela ne se produit plus (p=128)
Bonne journée
jean marie

Merci quand même Jean Marie même si tu n'as pas d'explication.
Bon à savoir, il faut trier la plage pour que ça corresponde.
Bonne journée.
Cath

 

[cathodique]

Bonjour cathodique, Jean-Marie, JB, le forum,

C'est pourtant simple, p n'est pas toujours égal à d.Count !

If d.exists(TblE(i, 1)) Then
p = d(TblE(i, 1)) ' Récupération index dans p
Else
d(TblE(i, 1)) = d.Count + 1: p = d.Count

Bonne journée.

Merci beaucoup à toi de m'avoir éclairé. En effet, p est l'index.
Ne m'en veuillez pas, petite tête et neurones en déperdition.
ça ne fonctionne plus comme avant.

Un grand merci.

Bonne journée.

 

[cathodique]

Bonjour,

A l'affichage dans le tableur , on ne prend que les lignes non vides de TblS()

Sub SousTotalNonTrié()
  Set d = CreateObject("Scripting.Dictionary")
  TblE = Range("A2:C" & [a65000].End(xlUp).Row)                           ' Table entrée
  Dim TblS(): ReDim TblS(1 To UBound(TblE), 1 To UBound(TblE, 2))         ' Table sortie
  For i = LBound(TblE) To UBound(TblE)
    clé = TblE(i, 1) & "|" & TblE(i, 2)
    If d.exists(clé) Then
      lig = d(clé)                                             ' Récupération index TblS()
   Else
     d(clé) = d.Count + 1: lig = d.Count: TblS(lig, 1) = TblE(i, 1): TblS(lig, 2) = TblE(i, 2)
   End If
   For c = 3 To UBound(TblE, 2): TblS(lig, c) = TblS(lig, c) + TblE(i, c): Next c  ' Totalisation numérique
  Next i
  [E2].Resize(d.Count, UBound(TblS, 2)) = TblS     ' on ne prend que les cellules pleines de TblS()
End Sub

Boisgontier

Bonjour JB,

Merci pour ton retour. C'est suite à cette discussion concernant un tri à la suite de la procédure de ton fichier (totalisation).
J'ai eu des surprises à la suite du tri. En effet, au transfert je m'étonnais de rien trouver sur la feuille. En réalité, le début de la feuille contenait les données vides (cases vides du tableau).
J'ai donc poursuivi mes recherches pour solutionner mon problèmes car je dois encore traiter le tableau obtenu avant de l'envoyer sur une feuille.
Je suis tombé sur ton fichier répondant à peu près à mon souci. Et je me suis dis, étant donné qu'on ne peut modifier que la dernière dimension. Alors je transpose le tableau et le traite à l'inverse pour ne garder que colonnes qui ne sont pas vides et ensuite le re-transpose. J'obtiendrai ainsi un tableau sans lignes vides et pouvoir utiliser ta fonction de tri.
Le plus simple aurait été de trier la plage avant de la prendre dans un tableau. Elle est déjà triée et je ne dois pas toucher à ce tri. Voilà, le pourquoi de toute cette gymnastique.

Merci quand même, mais dans ton exemple les 2 tableaux ont les mêmes dimensions. Le tableau de sortie TblS est de lig=129 à 400 vide d'où la surprise après le tri.

Ou bien transposer le tableau et ensuite utiliser ta procédure de totalisation, en alimentant au fur et à mesure le tableau final. Mais là, pour moi c'est une autre paire de manche. Je m'y attèle sans garanti de succès.

Bonne journée.

 

[Paf]

Bonjour à tous

une autre solution non triée en passant par 2 dicos:

Sub  TotalCode()
Dim d1, d2, i As Long, T, TRes
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
T = Range("A2:C" & [a65000].End(xlUp).Row)  ' Table entrée
For i = LBound(T, 1) To UBound(T, 1)
    d1(T(i, 1)) = T(i, 2)
    d2(T(i, 2)) = d2(T(i, 2)) + T(i, 3)
Next i
TRes = Application.Transpose(Array(d1.keys, d1.items, d2.items))
[E2].Resize(d1.Count, UBound(T, 2)) = TRes
End Sub

 

[cathodique]

Bonjour à tous

une autre solution non triée en passant par 2 dicos:

Sub  TotalCode()
Dim d1, d2, i As Long, T, TRes
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
T = Range("A2:C" & [a65000].End(xlUp).Row)  ' Table entrée
For i = LBound(T, 1) To UBound(T, 1)
    d1(T(i, 1)) = T(i, 2)
    d2(T(i, 2)) = d2(T(i, 2)) + T(i, 3)
Next i
TRes = Application.Transpose(Array(d1.keys, d1.items, d2.items))
[E2].Resize(d1.Count, UBound(T, 2)) = TRes
End Sub

Bonjour Paf,

Je te remercie beaucoup pour ton aide. J'ai vu ton message hier soir, mais je n'ai pas pu te répondre car le site était en maintenance.

J'ai essayé de d'adapter le code de JB, mais en partant du tableau transposer sans. Je me suis pris la tête et abandonné pour le moment (pour avancer sur mon fichier). Mais je ne lâche pas le morceau, je reprendrai l'adaptation plus tard à tête reposée.
Déjà que je ne maitrise pas parfaitement les tableaux vba normaux, alors travailler avec une transposée c'est comme si je marchais la tête à l'envers.

Encore merci pour ta proposition, ça va me permettre d'alléger mon code et m'éviter la "gymnastique" pour virer du tableau les données vides.

Toute ma gratitude.

Bon week-end.

 

[Paf]

Puisque le résultat des dicos est "collé" dans un tableau, on peut lui applique la function de tri de J. BOISGONTIER, avant sa copie dans la feuille .

Bonne suite

 

[cathodique]

Puisque le résultat des dicos est "collé" dans un tableau, on peut lui applique la function de tri de J. BOISGONTIER, avant sa copie dans la feuille .

Bonne suite

En effet, avec ta proposition on peut lui appliquer la fonction tri de J. BOISGONTIER.

Merci beaucoup.

Bon week-end.