Microsoft 365 Chargement table vba dans onglet

[Mongo]

Bonjour,
Je vous joins un fichier simplifié dans lequel j'ai un souci dans une macro pour charger une table interne dans la feuille "Etiquettes".
Cette feuille étiquettes est censée contenir des étiquettes de 4 lignes sur 4 colonnes chacune et ce sur un total de 8 colonnes : donc 2 étiquettes cotes à cotes.
La macro CreationEtiquettes récupère les données dans l'onglet ZITMPRIX, les traite via une table interne et est censée les copier dans l'onglet étiquettes.
Là, je bute sur cette macro car le résultat qui devrait être tel que dans la zone grisée de l'onglet étiquettes est totalement désorganisé. Je ne comprends pas pourquoi.

Merci d'avance,

 

[Dranreb]

Bonsoir.
Conseil: Travaillez avec deux tableaux dynamiques en mémoire, ce sera à la fois plus simple et beaucoup plus rapide.

 

[Mongo]

Bonsoir.
Conseil: Travaillez avec deux tableaux dynamiques en mémoire, ce sera à la fois plus simple et beaucoup plus rapide.

Bonsoir Dranreb,
C'est ce que j'ai fait mais je n'arrive pas à vider le tableau cible dans l'onglet final.

 

[Dranreb]

Ah oui, je n'avais pas vu, j'étais seulement tombé sur le code du Module2
Suite à quoi j'ai écrit ça qui vide bien le tableau cible :

Option Explicit
Sub CreationEtiquettes()
   Dim TDon(), LD As Long, CD As Integer, TEtq(), L0E As Long, C0E As Integer, C As Integer
   TDon = [ZITMPRIX].Value
   ReDim TEtq(1 To (5 * UBound(TDon, 1) + 9) \ 2, 1 To 8)
   For LD = 1 To UBound(TDon, 1)
      TEtq(L0E + 1, C0E + 1) = TDon(LD, 2)
      TEtq(L0E + 1, C0E + 4) = TDon(LD, 1)
      TEtq(L0E + 2, C0E + 1) = "Prix de base TTC"
      TEtq(L0E + 2, C0E + 3) = TDon(LD, 5)
      TEtq(L0E + 3, C0E + 1) = "Tarifs remisés TTC"
      For C = 0 To 3
         If TDon(LD, 6 + 4 * C) = "" Then Exit For
         TEtq(L0E + 4, C0E + 1 + C) = "de " & TDon(LD, 6 + 4 * C) & " à " & TDon(LD, 7 + 4 * C) & " articles"
         TEtq(L0E + 5, C0E + 1 + C) = TDon(LD, 8 + 4 * C)
         Next C
      C0E = (C0E + 4) Mod 8: If C0E = 0 Then L0E = L0E + 5
      Next LD
   Feuil4.[A:H].Clear
   Feuil4.[A1].Resize(L0E, 8).Value = TEtq
   End Sub

Reste à ajouter des mises en formes, probablement par copy/collage spécial de format …

 

[Dranreb]

Avec le test sur le magasin :

Option Explicit
Sub CreationEtiquettes()
   Dim TDon(), LD As Long, CD As Integer, TEtq(), L0E As Long, C0E As Integer, C As Integer, CMag As Integer
   TDon = [ZITMPRIX].Value
   ReDim TEtq(1 To 20000, 1 To 8)
   For LD = 1 To UBound(TDon, 1)
      For CMag = 22 To 38
         If TDon(LD, CMag) <> 0 Then
            TEtq(L0E + 1, C0E + 1) = TDon(LD, 2)
            TEtq(L0E + 1, C0E + 4) = TDon(LD, 1)
            TEtq(L0E + 2, C0E + 1) = "Prix de base TTC"
            TEtq(L0E + 2, C0E + 3) = TDon(LD, 5)
            TEtq(L0E + 3, C0E + 1) = "Tarifs remisés TTC"
            For C = 0 To 3
               If TDon(LD, 6 + 4 * C) = "" Then Exit For
               TEtq(L0E + 4, C0E + 1 + C) = "de " & TDon(LD, 6 + 4 * C) & " à " & TDon(LD, 7 + 4 * C) & " articles"
               TEtq(L0E + 5, C0E + 1 + C) = TDon(LD, 8 + 4 * C)
               Next C
            C0E = (C0E + 4) Mod 8: If C0E = 0 Then L0E = L0E + 5
            End If
         Next CMag
      Next LD
   Feuil4.[A:H].Clear
   Feuil4.[A1].Resize(L0E, 8).Value = TEtq
   End Sub

 

[Mongo]

Avec le test sur le magasin :

Option Explicit
Sub CreationEtiquettes()
   Dim TDon(), LD As Long, CD As Integer, TEtq(), L0E As Long, C0E As Integer, C As Integer, CMag As Integer
   TDon = [ZITMPRIX].Value
   ReDim TEtq(1 To 20000, 1 To 8)
   For LD = 1 To UBound(TDon, 1)
      For CMag = 22 To 38
         If TDon(LD, CMag) <> 0 Then
            TEtq(L0E + 1, C0E + 1) = TDon(LD, 2)
            TEtq(L0E + 1, C0E + 4) = TDon(LD, 1)
            TEtq(L0E + 2, C0E + 1) = "Prix de base TTC"
            TEtq(L0E + 2, C0E + 3) = TDon(LD, 5)
            TEtq(L0E + 3, C0E + 1) = "Tarifs remisés TTC"
            For C = 0 To 3
               If TDon(LD, 6 + 4 * C) = "" Then Exit For
               TEtq(L0E + 4, C0E + 1 + C) = "de " & TDon(LD, 6 + 4 * C) & " à " & TDon(LD, 7 + 4 * C) & " articles"
               TEtq(L0E + 5, C0E + 1 + C) = TDon(LD, 8 + 4 * C)
               Next C
            C0E = (C0E + 4) Mod 8: If C0E = 0 Then L0E = L0E + 5
            End If
         Next CMag
      Next LD
   Feuil4.[A:H].Clear
   Feuil4.[A1].Resize(L0E, 8).Value = TEtq
   End Sub

Avant même de le tester, je suis impressionné par l'optimisation du code 🧠
Je regarde demain matin et te fais un retour dans la foulée.

 

[Mongo]

Avant même de le tester, je suis impressionné par l'optimisation du code 🧠
Je regarde demain matin et te fais un retour dans la foulée.

Ca marche du tonnerre.
J'ai ajouté quelques fioritures pour gérer quelques particularités de mon fichier mais ton code est vraiment super.
Encore Merci !!!

 

[Dranreb]

Bonjour.
Attention, je pense qu'il manque une instruction juste avant de décharger le tableau :

If C0E > 0 Then L0E = L0E + 5

Sinon on risque de ne pas prendre la dernière étiquette si elles sont en nombre impair.

 

[Mongo]

Bonjour.
Attention, je pense qu'il manque une instruction juste avant de décharger le tableau :

If C0E > 0 Then L0E = L0E + 5

Sinon on risque de ne pas prendre la dernière étiquette si elles sont en nombre impair.

Bonjour,
Tout juste, ça corrige le problème 👍👍👍