Alimentation tableau temporaire [VBA]

Version imprimable

Bonjour à toutes et à tous,

Dans une macro, je souhaite extraire des données d'un tableau et les réécrire en fonction d'une variable (un paquet) dans des lignes différentes au besoin.

Exemple : une ligne avec une valeur "quantité" = 100 à séparer en 3 lignes de 30 et une ligne de 10 (pour arriver au même total).

Voici donc la macro que j'ai écrite ("Option Explicit" inscrit en début, je vous épargne donc toutes les variables définies) :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 Dim r As Integer ' N° de ligne en-cours en lecture Dim l As Integer ' N° de ligne en-cours en écriture l = 2 For r = 2 To ligFin ligDat = Cells(r, colDat).Value ligCde = Cells(r, colCde).Value ligGen = Cells(r, colEan).Value ligPcb = Cells(r, colPcb).Value ligRec = Cells(r, colQte).Value ligEcr: If ligRec <= ligPcb Then tabTmp(l, 1) = ligDat tabTmp(l, 2) = ligCde tabTmp(l, 3) = ligGen tabTmp(l, 4) = ligPcb tabTmp(l, 5) = ligRec GoTo ligSui ElseIf ligRec > ligPcb Then tabTmp(l, 1) = ligDat tabTmp(l, 2) = ligCde tabTmp(l, 3) = ligGen tabTmp(l, 4) = ligPcb tabTmp(l, 5) = ligPcb ligRec = ligRec - ligPcb l = l + 1 GoTo ligEcr End If ligSui: Next r
Il passe en premier dans la boucle "ElseIf" (car la quantité totale est supérieur à la quantité d'un paquet donc nécessité de créer plusieurs lignes) puis bloque lorsqu'il repasse dans la boucle " If ligRec <= ligPcb Then" pour écrire la dernière ligne.
Je me retrouve avec une "Erreur d'exécution 9 : l'indice n'appartient pas à la sélection" sur la ligne "tabTmp(l, 1) = ligDat".

Je pense que cela vient de "l = l + 1" qui pour moi devait me servir à écrire sur une ligne différente que la ligne de lecture d'origine mais je ne trouve pas la solution.

Merci d'avance pour vos éclaircissements.

Deux petits conseils qui ne règleront pas ton problème mais t'aideront à développer : Fais des itération pour mieux visualiser tes structures et évite au maximum les Goto (perso, je n'en utilise JAMAIS, il y a toujours un moyen de s'en passer).

Exemple pour ton code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 l = 2 For r = 2 To ligFin ligDat = Cells(r, colDat).Value ligCde = Cells(r, colCde).Value ligGen = Cells(r, colEan).Value ligPcb = Cells(r, colPcb).Value ligRec = Cells(r, colQte).Value Do tabTmp(l, 1) = ligDat tabTmp(l, 2) = ligCde tabTmp(l, 3) = ligGen tabTmp(l, 4) = ligPcb tabTmp(l, 5) = ligRec ligRec = ligRec - ligPcb l = l + 1 Loop Until ligRec <= ligPcb Next r
Ou bien :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 l = 2 For r = 2 To ligFin ligDat = Cells(r, colDat).Value ligCde = Cells(r, colCde).Value ligGen = Cells(r, colEan).Value ligPcb = Cells(r, colPcb).Value For ligRec = Cells(r, colQte).Value To ligPcb Step -ligPcb tabTmp(l, 1) = ligDat tabTmp(l, 2) = ligCde tabTmp(l, 3) = ligGen tabTmp(l, 4) = ligPcb tabTmp(l, 5) = ligRec Next ligRec Next r
Pour le second code, je suis un peu moins sûr que pour le premier qu'il fasse la même chose que ton code mais tu vois un peu l'idée pour ce qui est de itération et de la suppression des Goto.

18/05/2015, 22h30
clementmarcotte

Bonjour,

Citation:

Envoyé par Menhir

évite au maximum les Goto (perso, je n'en utilise JAMAIS, il y a toujours un moyen de s'en passer).

Enfin, presque toujours :lol:

On ne peut pas toujours éviter ou, du moins, on ne devrait pas toujours éviter... ;)

Code:

On Error Goto

Mais bon c'est un GoTo "exotique".
19/05/2015, 08h36
Noël35

Merci pour vos réponses.

Je vais enlever les GoTo (j'ai pris cette - plus ou moins - "mauvaise" habitude :) ).

Je planche toujours sur mon problème, si quelqu'un a une solution, merci d'avance.

Bonne journée !!!
19/05/2015, 09h10
Menhir

Citation:

Envoyé par clementmarcotte

Enfin, presque toujours :lol:

Depuis que le Basic a abandonné les numéros systématiques des lignes (c'est-à-dire depuis que je suis passé au Quick Basic fin des années 80) et a emprunté au Pascal ses boucles, je n'ai plus jamais utilisé un Goto. Je n'ai même plus le réflexe d'imaginer en utiliser un.

Citation:

Code:

On Error Goto

Mais bon c'est un GoTo "exotique".

J'évite celui-ci encore plus que les autres.
Il a encore plus de défaut puisqu'on n'est même pas sûr de la ligne qui va le déclencher.
De plus, il masque les problèmes plutôt que de les résoudre.
A utiliser avec autant de précaution que de la nitroglycérine et uniquement en fin de développement quand le programme est entièrement débugué.

Mais, bien entendu, tout ça est un avis personnel qui n'est pas gravé dans le marbre. Chacun a son style de développement. :wink:
19/05/2015, 20h34
clementmarcotte

Bonjour,

Citation:

Envoyé par Menhir

J'évite celui-ci encore plus que les autres.
Il a encore plus de défaut puisqu'on n'est même pas sûr de la ligne qui va le déclencher.
De plus, il masque les problèmes plutôt que de les résoudre.
A utiliser avec autant de précaution que de la nitroglycérine et uniquement en fin de développement quand le programme est entièrement débugué.

L'idée c'est de traiter la condition d'erreur et d'appliquer les mesures correctives pour éviter de planter le programme. ;)

C'est comme à l'époque des disquettes. On pouvait passer par là pour dire à l'utilisateur de changer de disquette. Mais, je suis tout à fait d'accord pour dire qu'il faut être quand même prudent, et surtout pas, l'utiliser sans discernement. Cela peut devenir de la dynamite.

Citation:
Envoyé par Menhir
Deux petits conseils qui ne règleront pas ton problème mais t'aideront à développer : Fais des itération pour mieux visualiser tes structures et évite au maximum les Goto (perso, je n'en utilise JAMAIS, il y a toujours un moyen de s'en passer).

Exemple pour ton code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 l = 2 For r = 2 To ligFin ligDat = Cells(r, colDat).Value ligCde = Cells(r, colCde).Value ligGen = Cells(r, colEan).Value ligPcb = Cells(r, colPcb).Value ligRec = Cells(r, colQte).Value Do tabTmp(l, 1) = ligDat tabTmp(l, 2) = ligCde tabTmp(l, 3) = ligGen tabTmp(l, 4) = ligPcb tabTmp(l, 5) = ligRec ligRec = ligRec - ligPcb l = l + 1 Loop Until ligRec <= ligPcb Next r
J'ai utilisé ton code mais j'obtiens un problème lors de l'écriture de mon tableau dont voici le code

Code:

Range(Cells(1, 1), Cells(UBound(tabTmp, 1), UBound(tabTmp, 2))) = tabTmp

Du coup je pense vraiment que le problème de mon code

Code:

l = l + 1

qui pour moi devait me servir à écrire sur une ligne différente que la ligne de lecture d'origine mais je ne trouve pas la solution.

Merci d'avance pour vos retours.

20/05/2015, 12h09
Menhir

Citation:

Envoyé par Noël35

J'ai utilisé ton code mais j'obtiens un problème lors de l'écriture de mon tableau dont voici le code

"j'obtiens un problème", c'est un peu vague comme description de défaut...
20/05/2015, 13h42
Noël35

Oui pardon :oops:

La macro bloque sur la ligne

Code:

Range(Cells(1, 1), Cells(UBound(tabTmp, 1), UBound(tabTmp, 2))) = tabTmp

avec le message d'erreur

Citation:

"Erreur d'exécution '1004' : Erreur définie par l'application ou par l'objet"

Merci d'avance.
20/05/2015, 13h51
Menhir

Tu as écrit "j'ai utilisé ton code" mais cette ligne n'est dans aucun des deux codes que je t'ai donnés.
Tu as donc du le mélanger à autre chose.
Sans savoir ce qui conduit à cette ligne, impossible de savoir ce qui provoque l'erreur.
Mais commence par regarder ce que renvoie tes Ubound.
20/05/2015, 14h25
Noël35

Oui je me suis très mal exprimé sur mon message.

Je voulais dire que depuis que j'ai insérer ton code pour éviter les "Go To", la macro lit bien la ligne et rempli apparement correctement le tableau temporaire tabTmp mais j'ai un problème lorsque j'utilise la ligne

Code:

Range(Cells(1, 1), Cells(UBound(tabTmp, 1), UBound(tabTmp, 2))) = tabTmp

pour écrire le tableau temporaire dans un onglet.

"(UBound(tabTmp, 1)" renvoi la valeur "2" et "UBound(tabTmp, 2)" la valeur "9999".

C'est la première fois que j'utilise les tableaux en VBA et du coup aussi la fonction UBound et je ne dois pas tout encore comprendre.
20/05/2015, 14h33
Menhir

Essaye de mettre un .Value lié à ton Range (entre la dernière parenthèse et le =).

J'ai changer la ligne de macro par

Code:

Range(Cells(1, 1), Cells(UBound(tabTmp, 1), UBound(tabTmp, 2))).Value = tabTmp

mais elle bloque au même endroit et avec le même message d'erreur ('Erreur d'exécution '1004' : Erreur définie par l'application ou par l'objet').

Merci en tout cas pour ton aide.

La ligne de macro par

Code:

Range(Cells(1, 1), Cells(UBound(tabTmp, 1), UBound(tabTmp, 2))).Value = tabTmp

fonctionne désormais : elle n'aimait pas la valeur "9999" apparement.

Le bout de code de Menhir (Do et Loop Until) fonctionne mieux que ce que j'avais écris mais le résultat n'est pas encore celui attendu : je travail sur cela demain et revient vers vous.

Merci pour votre aide.

Bonjour à tous,

Je me suis remis sur cette macro ce matin et j'ai eu confirmation que le code de "Menhir" concernant le "Do - Loop Until" ne faisait pas ce que je souhaitais.

J'ai donc essayer de modifier le code par celui-ci :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 For r = 2 To ligFin ligDat = Cells(r, colDat).Value ligCde = Cells(r, colCde).Value ligGen = Cells(r, colEan).Value ligPcb = Cells(r, colPcb).Value ligRec = Cells(r, colQte).Value Do tabTmp(l, 1) = ligDat MsgBox tabTmp(l, 1) tabTmp(l, 2) = ligCde MsgBox tabTmp(l, 2) tabTmp(l, 3) = ligGen MsgBox tabTmp(l, 3) tabTmp(l, 4) = ligPcb MsgBox tabTmp(l, 4) If ligRec < ligPcb Then tabTmp(l, 5) = ligRec MsgBox tabTmp(l, 5) Else tabTmp(l, 5) = ligPcb MsgBox tabTmp(l, 5) l = l + 1 End If ligRec = ligRec - ligPcb MsgBox ligRec Loop Until ligRec > 0 Next r
Je rappel ce que je recherches à faire : si la variable 'ligRec' est plus petite que 'ligPcb', finir d'écrire la ligne en utilisant 'ligRec' et passé à la ligne suivante ("Next r").
Si 'ligRec' est supérieur à 'ligPcb', finir d'écrire la ligne en utilisant 'ligPcb', mettre à jour 'ligRec' ("ligRec = ligRec - ligPcb") et continuer d'écrire sur une nouvelle ligne les mêmes éléments jusqu'à ce que 'ligRec' soit égale ou inférieur à 0, puis passé à la ligne suivante ("Next r").

Je pensais avoir codé cela dans le "Do - Loop Until" mais cela ne fonctionne pas : pas de plantage de la macro, il ne boucle qu'une fois et alimente uniquement avec ligPcb alors que la valeur de 'ligRec' de la MsgBox est bien de '1'.

Merci de vos retours si vous avez une idée.

A mon avis, tu devrais remplacer tes MsgBox par des Debug.Print qui sont bien plus pratiques en phase de débugage.

Un code plus simple que le tien

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
For r = 2 To ligFin
    ligDat = Cells(r, colDat).Value
    ligCde = Cells(r, colCde).Value
    ligGen = Cells(r, colEan).Value
    ligPcb = Cells(r, colPcb).Value
 
    l = 1
    For ligRec = Cells(r, colQte).Value To 0 Step -ligPcb
        tabTmp(l, 1) = ligDat
        tabTmp(l, 2) = ligCde
        tabTmp(l, 3) = ligGen
        tabTmp(l, 4) = ligPcb
        tabTmp(l, 5) = ligPcb
        If ligRec < ligPcb Then
           tabTmp(l, 5) = ligRec
           Exit For
        End If
        l = l + 1
     Next ligRec
Next r

21/05/2015, 11h38
Noël35

Citation:

Envoyé par Menhir

A mon avis, tu devrais remplacer tes MsgBox par des Debug.Print qui sont bien plus pratiques en phase de débugage.

Effectivement, ton code passe bien deux boucles mais j'ai un problème lors de l'écriture de mon tableau (il ne m'écrit qu'une ligne). Je passe du temps cette après-midi là dessus et te tiens au courant.

Merci pour ton aide rapide qui plus est !!! :)

PS : je n'ai jamais utilisé les Debug.Print mais je vais me pencher là-dessus, encore merci pour tes éclaircissements.
21/05/2015, 11h46
Menhir

Citation:

Envoyé par Noël35

PS : je n'ai jamais utilisé les Debug.Print mais je vais me pencher là-dessus, encore merci pour tes éclaircissements.

C'est encore plus facile à utiliser que MsgBox.
La seule chose, c'est qu'il faut avoir ouvert la fenêtre d'exécution dans l'éditeur VBA (Ctrl+G).
22/05/2015, 16h25
Noël35

Effectivement, c'est plutot sympa le Debug.Print :)

Je n'ai pas encore trouvé pour la solution pour l'écriture des lignes du tableau mais je reviens vers vous dès que !!!

Merci encore et bon weekend !!!

Bonjour,

Avec l'aide que l'on m'a apporter ici, j'ai réussi à stabiliser mon code VBA et surtout à effectuer plus ou moins ce que je voulais !!! :)

Donc, un grand merci à tout le monde pour votre aide... et je n'oublie pas de cocher "résolu".

Je pose mon code définitif (désfois que ça peut servir) à quelqu'un
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 ' Création tableau temporaire Dim x, y As Integer Dim tabTmp() As String ' Redimensionne le tableau x = ligFin y = colFin ReDim tabTmp(1 To 9999, 1 To y) l = 1 ' Alimente les éléments du tableau For r = 2 To ligFin ligDat = Cells(r, colDat).Value ligCde = Cells(r, colCde).Value ligGen = Cells(r, colEan).Value ligPcb = Cells(r, colPcb).Value ' For ligRec = Cells(r, colQte).Value To 1 Step -ligPcb l = l + 1 tabTmp(l, 1) = ligDat tabTmp(l, 2) = ligCde tabTmp(l, 3) = ligGen tabTmp(l, 4) = ligPcb tabTmp(l, 5) = ligPcb If ligRec < ligPcb Then tabTmp(l, 5) = ligRec Exit For End If Next ligRec Next r
Et pour le "moins" du "plus ou moins" écrit plut haut, si quelqu'un a une idée, cela concerne la redimenssion du tableau : je n'arrive pas à avoir un tableau dynamique donc j'ai du utiliser la valeur "9999" dans le bout de

Code:

ReDim tabTmp(1 To 9999, 1 To y)

. A noter que j'ai essayer la redimenssion automatique (avec le mot clé "PRESERVE" mais ca ne fonctionne pas dans mon cas vu que l'on peut uniquement modifier la dernière dimension du tableau).

Merci encore !!!