Copie de cellules sous condition avec utilisation d'un tableau

Dans le fichier joint, je souhaiterais pouvoir copier tous les nouveaux produits de la feuille MVTS vers la feuille ETAT_STOCK mais également leur description, unité et prix unitaire. Le produit étant donc la clé primaire.

Il peut y avoir des doublons dans la feuille MVTS (ce qui est normal) mais pas dans la feuille ETAT_STOCK (car celle-ci une synthèse de tous les mouvements effectués…un peu à l’image d’un TCD).

J'ai réalisé un code fonctionnel avec une double boucle mais celle-ci ralenti considérablement l'exécution de la macro lorsque le nombre de lignes est conséquent.

Pour la rapidité, je pense qu'il serait préférable d'utiliser un tableau, array et/ou dictionnaire mais étant novice, j'ai un peu mal.

C'est la raison pour laquelle je sollicite votre aide

Merci

Hello,

Dommage qu'on ai pas le code dans ton fichier ...

C'est quoi un nouveau produit ??? Tout ce qu'il y a dans la feuille mvts ?

Un "nouveau" produit est un produit qui ne figure pas dans la feuille "ETAT_STOCK". Il est donc "nouveau" pour cette feuille

J'ai ajouté le code avec la boucle. Pour le moment, la copie se passe rapidement car il y a peu de produits dans la feuille "MVTS".

Mais la quantité de produits va rapidement augmenter.

Merci

Bonjour Osaka, le forum,

Salut Rag02700,

Un essai....

Sub Macro1()
 Dim tablo, tabloR(), k As Long, i As Long
 Dim dico As Object

  With Sheets("MVTS")
   tablo = .ListObjects("Tableau_MVTS").DataBodyRange
   Set dico = CreateObject("Scripting.Dictionary")

    k = 0
    For i = 2 To UBound(tablo, 1)
     If Not dico.exists(tablo(i, 3)) Then
      dico(tablo(i, 3)) = tablo(i, 3)
      ReDim Preserve tabloR(1 To 9, 1 To k + 1)
        tabloR(1, 1 + k) = tablo(i, 3)
        tabloR(2, 1 + k) = tablo(i, 4)
        tabloR(3, 1 + k) = tablo(i, 5)
        'tabloR(5, 1 + k) = Application.SumIf(.ListObjects("Tableau_MVTS").ListColumns(3).DataBodyRange, tablo(i, 3), .ListObjects("Tableau_MVTS").ListColumns(6).DataBodyRange)
        tabloR(8, 1 + k) = tablo(i, 7)
    k = 1 + k
     End If
    Next i
   End With

    With Sheets("ETAT_STOCK")
     .Range("A5").CurrentRegion.Offset(1, 0).ClearContents
      On Error Resume Next
     .Range("A6").Resize(UBound(tabloR, 2), 9) = Application.Transpose(tabloR)
    End With
End Sub

Cordialement,

Hello à tous,

@ mon cher ami xorsankukai (d'ailleurs tu ne m'as pas dit si tu étais + team sub zéro ou scorpion ), belle proposition mais il me semble qu'il y a y une petite coquille dans ta proposition

For i = 2 To UBound(tablo, 1)

il me semble que ton tableau commence à l'index 1.

Si je me trompe excuse moi

++

Bonjour xorsankukai, Rag02700

Merci pour ta proposition qui semble fonctionner Je dois encore l'adapter à mon fichier source.

Décidément, j'ai du mal à comprendre le fonctionnement des tableaux et dico

A+

Re,

Merci Osaka pour le retour,

Merci Rag02700 d'avoir relevé cette erreur...

A la base j'étais parti sur

tablo = .Range("A1").CurrentRegion

puis je me suis ravisé car il me semblait plus approprié d’utiliser

tablo = .ListObjects("Tableau_MVTS").DataBodyRange

mais j'ai oublié de rectifier....

(Je n'étais pas sûr non plus de la bonne utilisation du dico....).

tu ne m'as pas dit si tu étais + team sub zéro ou scorpion

Je n'arrive toujours pas à faire mon choix.....

Amitiés,

Bonne soirée à vous,

Bonjour xorsankukai,

J'essaie d'adapter ton code dans mon fichier car j'ai plusieurs opérations de copie différentes à réaliser.

En partant du même principe, que donnerait le code pour uniquement remplir les mouvements dans la colonne E (donc plus les colonnes 1, 2 , 3 et 8 mais uniquement la 5).

J'avoue avoir du mal avec les dimensions et redimensionnement d'un tableau. Pourrais-tu détailler stp ?

Merci à toi

Bonjour Osaka, Rag02700, le forum,

Tu n'as peut-être fait attention, mais j'avais prévu le remplissage de la colonne E..... , comme tu ne l'avais pas demandé, j'avais neutralisé la ligne.

Regarde le fichier joint.....En colonne E (sauf erreur), j'additionne les quantités...

Cordialement,