XL 2016 Probleme avec Redim Preserve

[S[1]t'Yor]

Bonjour à tous et à toutes !

Je viens vers vous car je rencontre un probleme dans mon programme. Je vous ai mis une partie de celui ci juste en dessus. Je pense que l'erreur est simple, c'est pour cela que je n'ai pas mis le fichier en entier.

n = 0
For k = 0 To Finferrures - DebutFerrures


    If appxl.ActiveCell.Value = 0 Then
        appxl.ActiveCell.Offset(1, 0).Activate
        
    ElseIf appxl.ActiveCell.Value = appxl.ActiveCell.Offset(-1, 0).Value Then
        appxl.ActiveCell.Offset(1, 0).Activate

    Else
        ReDim Preserve ListeFerrures(n, 1)
        ListeFerrures(n, 0) = appxl.ActiveCell.Value
        ListeFerrures(n, 1) = appxl.ActiveCell.Offset(0, 2).Value
        n = n + 1
        appxl.ActiveCell.Offset(1, 0).Activate
    End If
Next

Le problème que je rencontre est avec le Redim Preserve. Lorsque je fais la première itération du For, pas de problème, cela fait bien bien un tableau une ligne, 2 colonnes. Mais quand j'arrive à la deuxième, Erreur numéro 9. Pourtour j'incrémente n comme je l'ai vu/compris en parcourant d'autres forums mais la je ne comprend plus rien.

Je ne suis pas un pro du tout en VBA, j'ai besoin d'aide s'il vous plaît...


merci d'avance pour le temps que vous me consacrerez.

Cordialement

S[1]t'Yor

 

[Dranreb]

Bonjour.
Un Redim Preserve ne permet de redéfinir que la dernière dimension d'un tableau dynamique.

 

[S[1]t'Yor]

Donc si je comprend bien, dans ce cas la, il va redéfinir la dimension de mes colonnes ? Je l'ai lu plusieurs fois cette explication mais je ne l'ai pas comprise

 

[dysorthographie]

Bonjour,
Tu as trouvé la réponse.
Un redim à plusieurs dimensions ne peut pas être opéré plusieurs fois.

A toi de déterminer le n max avant de faire le seul et unique redim!

redim preserve tb(n) 'fonctionne plusieurs fois
Redim preserve Tb(n,1) 'fonctionne qu'une fois

 

[S[1]t'Yor]

C'est bizarre mais soit.

Du coup la comment je peux faire ? Dans la déclaration de mon tableau auparavant je peux bloquer une dimension ?
Dois je utiliser un autre type de variable ?
Merci d'avance

 

[Dranreb]

Vous pourriez éventuellement prévoir un tableau à une seule dimension mais dont chaque élément est un lui même un petit tableau à une dimension.
Vous auriez intéret aussi à travailler sur un tableau pour l'ensemble des données.

 

[S[1]t'Yor]

Superbe ca fonctionne !!

Mais du, il me vient une autre question : une fois mais tableaux complétés, est-il possible de les combiner pour n'en faire plus qu'un seul ?

Merci d'avance

 

[Dranreb]

Joignez donc un classeur montrant ce que vous avez et ce que voulez.

 

[S[1]t'Yor]

Bonjour,
Tu as trouvé la réponse.
Un redim à plusieurs dimensions ne peut pas être opéré plusieurs fois.

A toi de déterminer le n max avant de faire le seul et unique redim!

redim preserve tb(n) 'fonctionne plusieurs fois
Redim preserve Tb(n,1) 'fonctionne qu'une fois

Merci pour votre réponse, elle fonctionne aussi mais dans mon cas la solution de Dranreb m'est plus utile.

 

[S[1]t'Yor]

Joignez donc un classeur montrant ce que vous avez et ce que voulez.

Malheureusement, je ne peux pas. Je suis soumis à une clause de confidentialité. je vais essayé d'expliquer au mieux avec le code fonctionnel :

n = 0
For k = 0 To Finferrures - DebutFerrures


    If appxl.ActiveCell.Value = 0 Then
        appxl.ActiveCell.Offset(1, 0).Activate
        
    ElseIf appxl.ActiveCell.Value = appxl.ActiveCell.Offset(-1, 0).Value Then
        appxl.ActiveCell.Offset(1, 0).Activate

    Else
        ReDim Preserve ListeFerrures(n)
        ReDim Preserve QuantitesFerrures(n)
        ListeFerrures(n) = appxl.ActiveCell.Value
        QuantitesFerrures(n) = appxl.ActiveCell.Offset(0, 2).Value
        n = n + 1
        appxl.ActiveCell.Offset(1, 0).Activate
    End If
Next

Ma question est la suivante : j'ai deux tableaux de taille (n,1) : Liste ferrures et quantités ferrures. Mon but est de les combiner pour obtenir un seul tableau de taille (n,2) avec dans l'ordre Liste Ferrures première colonne et Quantités ferrures sur la deuxieme colonne.

Merci d'avance

 

[Dranreb]

Toujours pas clair. Joignez un classeur débarrassé de donnée confidentielles mais représentatif de la structure des vraie données. Possible que ma fonction Gigogne convienne.

 

[S[1]t'Yor]

Toujours pas clair. Joignez un classeur débarrassé de donnée confidentielles mais représentatif de la structure des vraie données. Possible que ma fonction Gigogne convienne.

je ne vais pouvoir faire ca que ce soir ou plus tard désolé.

 

[Dranreb]

Essayez comme ça :

   Dim TDon(), FerrPréc, T(), TFerr(), LD&, LF&
   TDon = ActiveCell.Resize(Finferrures - DebutFerrures + 1, 3).Value
   FerrPréc = 0
   For LD = 1 To UBound(TDon, 1)
      If TDon(LD, 1) = 0 Then FerrPréc = 0
      If TDon(LD, 1) <> FerrPréc Then
         LF = LF + 1
         ReDim Preserve T(1 To LF)
         T(LF) = Array(TDon(LD, 1), TDon(LD, 3))
         End If
      Next LD
   ReDim TFerr(1 To LF, 1 To 2)
   For LF = 1 To UBound(T, 1)
      TFerr(LF, 1) = T(LF)(0)
      TFerr(LF, 2) = T(LF)(1)
      Next LF

Ou même comme ça:

   Dim TDon(), FerrPréc, TFerr(), LD&, LF&
   TDon = ActiveCell.Resize(FinFerrures - DebutFerrures + 1, 3).Value
   FerrPréc = 0
   For LD = 1 To UBound(TDon, 1)
      If TDon(LD, 1) = 0 Then FerrPréc = 0
      If TDon(LD, 1) <> FerrPréc Then LF = LF + 1
      Next LD
   ReDim TFerr(1 To LF, 1 To 2)
   FerrPréc = 0
   LF = 0
   For LD = 1 To UBound(TDon, 1)
      If TDon(LD, 1) = 0 Then FerrPréc = 0
      If TDon(LD, 1) <> FerrPréc Then
         LF = LF + 1
         TFerr(LF, 1) = TDon(LD, 1)
         TFerr(LF, 2) = TDon(LD, 3)
         End If
      Next LD

À tester. Pas pu puisque pas de classeur joint.

 

[patricktoulon]

et pourquoi pas simplement redim preserve transposé et re transposer à la fin
exemple

Sub test()
Dim lignes&, colonnes&,a&,i&

lignes = 10

colonnes = 2

Dim montableau()

For i = 1 To lignes

a = a + 1

ReDim Preserve montableau(1 To colonnes, 1 To a)

Next

montableau = Application.Transpose(montableau)

MsgBox "montableau fait " & UBound(montableau) & " lignes  et " & UBound(montableau, 2) & " colonnes"

End Sub