XL 2019 Boucle for dans boucle for

Jeremy1

XLDnaute Nouveau
Bonjour,
J'ai un soucis de RAM sur l'utilisation de ma macro.

La partie de code bloquant est une boucle for dans une boucle for avec un if.
Mon but est de savoir pour chaque valeur dans TabRef savoir si elle est présente dans une colonne du classeur ou pas.
Ma boucle for Z permet de défiler dans la colonne du classeur et la boucle for I de passer à la valeur suivante de TabRef.

La boucle finis par consommer 1.3go de RAM et plante.

TabRef est un tableau 1 dimension du même nombre d'element que la boucle for environ 3500.
La boucle For Z va de 0 à environ 3500 éléments (cela augmente rapidement au fil des mois)
La boucle For i va de 0 à environ 1000 élément maximum


Code:
For Z = 0 To (LastRw - FirstRw)
            For i = 0 To (LastRwRéf - FirstRwRéf)
                If TabRef(i) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneRef).Text Then 'Si valeur trouvée
                    TabDoublon(x, 0) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneArt)
                    TabDoublon(x, 1) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneRef)
                    TabDoublon(x, 2) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneDate)
                    TabDoublon(x, 3) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneQTY)
                    x = x + 1
                    Exit For
                ElseIf (i = (LastRwRéf - FirstRwRéf)) Then
                    TabImport(y, 0) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneArt)
                    TabImport(y, 1) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneRef)
                    TabImport(y, 2) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneDate)
                    TabImport(y, 3) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneQTY)
                    Workbooks(tata).Sheets("toto").Rows(Z + 2).Interior.Color = vbGreen
                    y = y + 1
                End If
            Next
        Next

Cordialement,
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Sans classeur joint pour pouvoir comprendre de quoi vous parlez, que voulez-vous que je vous dises ?
Ah, vous parlez probablement de la case à cocher de la liste des références disponibles.
Et bien vous pouvez désormais déclarer des variables As New Dictionary.
 

Dranreb

XLDnaute Barbatruc
Remarque: vous auriez intérêt à charger la totalité des plages impliqués dans des tableaux dynamiques, ce serait considérablement plus rapide.
Ça donnerait à peu près ça :
VB:
    Dim RngDonn As Range, TabDonnées() As Variant, LDonn As Long, Dic As New Dictionary, _
      TabDoublon(), LDoub As Long, TabImport(), LImpt As Long, C As Integer
   Set RngDonn = Workbooks(tata).Sheets("toto").Cells(2, 1).Resize(LastRwRéf - 1, 50)
   TabDonnées = RngDonn.Value
   ReDim TabDoublon(1 To UBound(TabDonnées, 1), 1 To 4), TabImport(1 To UBound(TabDonnées, 1), 1 To 4)
   For LDonn = 1 To UBound(TabDonnées, 1)
      If Dic.Exists(TabDonnées(LDonn, ColonneRef)) Then
         LDoub = LDoub + 1
         For C = 1 To 4: TabDoublon(LDoub, C) = TabDonnées(LDonn, Choose(C, ColonneArt, ColonneRef, ColonneDate, ColonneQTY)): Next C
      Else
         Dic.Add TabDonnées(LDonn, ColonneRef), Empty
         LImpt = LImpt + 1
         For C = 1 To 4: TabImport(LImpt, C) = TabDonnées(LDonn, Choose(C, ColonneArt, ColonneRef, ColonneDate, ColonneQTY)): Next C
         Rng.Rows(LDonn + 1).Interior.Color = vbGreen
         End If
      Next LDonn
 
Dernière édition:

Jeremy1

XLDnaute Nouveau
Remarque: vous auriez intérêt à charger la totalité des plages impliqués dans des tableaux dynamiques, ce serait considérablement plus rapide.
Ça donnerait à peu près ça :
VB:
    Dim RngDonn As Range, TabDonnées() As Variant, LDonn As Long, Dic As New Dictionary, _
      TabDoublon(), LDoub As Long, TabImport(), LImpt As Long, C As Integer
   Set RngDonn = Workbooks(tata).Sheets("toto").Cells(2, 1).Resize(LastRwRéf - 1, 50)
   TabDonnées = RngDonn.Value
   ReDim TabDoublon(1 To UBound(TabDonnées, 1), 1 To 4), TabImport(1 To UBound(TabDonnées, 1), 1 To 4)
   For LDonn = 1 To UBound(TabDonnées, 1)
      If Dic.Exists(TabDonnées(LDonn, ColonneRef)) Then
         LDoub = LDoub + 1
         For C = 1 To 4: TabDoublon(LDoub, C) = TabDonnées(LDonn, Choose(C, ColonneArt, ColonneRef, ColonneDate, ColonneQTY)): Next C
      Else
         Dic.Add TabDonnées(LDonn, ColonneRef), Empty
         LImpt = LImpt + 1
         For C = 1 To 4: TabImport(LImpt, C) = TabDonnées(LDonn, Choose(C, ColonneArt, ColonneRef, ColonneDate, ColonneQTY)): Next C
         Rng.Rows(LDonn + 1).Interior.Color = vbGreen
         End If
      Next LDonn
Merci. Je regarde semaine prochaine votre code et l’utilisation de cette fonction que je ne connaissais pas.
 

Jeremy1

XLDnaute Nouveau
J'ai passé ma comparaison du IF en tableau dynamique et cela à réglé le problème de RAM passant de 1300Mo à 80Mo.
Je ne sais pas si votre solution était celle la mais pour l'instant cela fonctionne bien plus vite (16sec à la place de 5min).
Votre solution m'interesse malgres tout si vous pensez que cela accelera encore la macro par rapport à la modification ci dessous ? Je regarde pour ajouter un classeur sans données sensible dans la journée.

Code:
For Z = 0 To (LastRw - FirstRw)
           For i = 0 To (LastRwRéf - FirstRwRéf)
               If TabRef(i) = TabPortofolio(Z) Then 'Si valeur trouvée
                   TabDoublon(x, 0) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneArt)
                   TabDoublon(x, 1) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneRef)
                   TabDoublon(x, 2) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneDate)
                   TabDoublon(x, 3) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneQTY)
                   x = x + 1
                   Exit For
               ElseIf (i = (LastRwRéf - FirstRwRéf)) Then
                   TabImport(y, 0) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneArt)
                   TabImport(y, 1) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneRef)
                   TabImport(y, 2) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneDate)
                   TabImport(y, 3) = Workbooks(tata).Sheets("toto").Cells(FirstRwRéfVar + Z, ColonneQTY)
                   Workbooks(tata).Sheets("toto").Rows(Z + 2).Interior.Color = vbGreen
                   y = y + 1
               End If
           Next
       Next
 
Dernière édition:

Jeremy1

XLDnaute Nouveau
Bonjour,
Voici un exemple avec des données.

le but et de comparer la "Col2" de "Sheet2" avec la "Col1" de "Sheet1". Si je trouve une correspondance je place les infos de la ligne de sheet 2 dans une tableau "Tabimport" que je recopie dans une nouvelle feuille sinon dans "Taddoublon" (la même chose).

Le sheet 1 va contenir potentiellement 100 000 lignes plus tard. Le sheet 2 devrait pas dépasser les 1 000 lignes.

Merci.
 

Pièces jointes

  • Exemple 1.0.xlsm
    321 KB · Affichages: 7

Dranreb

XLDnaute Barbatruc
Bonjour.
Vous perdez une grande partie du bénéfice du tableau dynamique en le chargeant par une boucle au lieu d'une seule instruction. Attention, la Value d'un Range de plusieurs cellules est toujours basé 1, et a 2 dimensions même s'il n'y a qu'une ligne ou 1 colonne.

En fait il faut tout charger sans boucle dans des tableaux au début, dimensionner des tableaux résultants souhaités, qu'on déchargera sans boucle à la fin, et entres les 2 ne travailler par boucles qu'avec les tableaux.

Ne jamais utiliser Cell dans une boucle: ce n'est guère plus rapide pour une seule cellule que pour 100000 d'un coup !
 
Dernière édition:

Jeremy1

XLDnaute Nouveau
Merci pour votre réponse.

Je suis en train de modifier le code. Je coince sur le fait qu'une donnée est en nombre et l'autre en texte.
Je cherche à mettre en texte pour la comparaison. peut-on le faire directement dans la ligne TabRef=RngDonn.Value?

VB:
        Dim RngDonn As Range
        Set RngDonn = Sheets("Sheet1").Cells(FirstRwRéfVar, ColonneRef).Resize(LastRwRéf - FirstRwRéf, 1)
        TabRef = RngDonn.Value
        Set RngDonn = Nothing
        
        'For i = 0 To (LastRwRéf - FirstRwRéf)
         '   TabRef(i) = Sheets("Sheet1").Cells(FirstRwRéfVar, ColonneRef)
         '   FirstRwRéfVar = FirstRwRéfVar + 1
        'Next
        'Erase TabRef()
 

Dranreb

XLDnaute Barbatruc
Oui j'avais vu. Je reconvertit en nombre le texte pour en faire une clé de Dictionary.
J'ai commencé un début, mais je n'ai pas saisi tous les détails pour continuer.
VB:
Option Explicit
Sub Main()
   Dim TDon(), LD&, TImp(), LI&, TPFo(), LP&, TRés(), LR&, Dic As Dictionary
   Set Dic = New Dictionary
   TDon = WshSheet1.[A2].Resize(WshSheet1.[A1000000].End(xlUp).Row - 1).Value
   For LD = 1 To UBound(TDon, 1): Dic(CDbl(TDon(LD, 1))) = Empty: Next LD
   TDon = WshSheet2.UsedRange.Value
   For LD = 2 To UBound(TDon, 1)
      If Dic.Exists(TDon(LD, 2)) Then
WShSheet1 et WshSheet2 sont ce en quoi j'ai renommé les objets Worksheet représentant les feuilles "Sheet1" et "Sheet2"
 

Jeremy1

XLDnaute Nouveau
Je me renseigne sur la fonction dictionary car je ne comprends pas le fonctionnement de votre code avec les for.

On est obligé d'activer la dll scrrun.dll? Car cela va etre genant pour moi. La macro s'utilise sur plusieurs poste.

VB:
Set MyDictionary = CreateObject("Scripting.Dictionary")
Ceci fonctionne sans l'activer?

VB:
Sheets("Sheet2").Range("B2:B" & [B65000].End(xlUp).Row).NumberFormat = "@"
La ligne ci dessus convertis en texte mais cela ne fonctionne pas, c'est comme s'il fallait cliquer sur la cellule et appuyer sur Entrer pour que le format s'applique reelement...
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Pas d'inquiétude, une référence est associée au projet VBA du classeur, et donc le fichier dll est ouvert lors de l'ouverture du classeur sur n'importe quel poste. Un CreateObject l'ouvre aussi d'ailleurs, la seule différence c'est que sans la référence cochée le type Dictionary n'est pas connu, de sorte qu'il faut l'utiliser à travers un Object, ce qui aboutit à des liaisons tardives, lors de l'exécution et un tout petit peu moins performantes.
Ça ne sert à rien de changer le format d'affichage de cellule, ça ne change plus son contenu.
 

Jeremy1

XLDnaute Nouveau
Je n'arrive pas à bien comprendre votre code ni à l'utiliser sur l'exemple...

VB:
        Dim TabRef(), TabImport(), TabDoublon(), TabPortofolio(), LD&, LI&, LP&, Dic As Dictionary
   
[CODE=vb]
        Set Dic = New Dictionary
        TabRef = Sheets("Sheet1").Cells(FirstRwRéfVar, ColonneRef).Resize(LastRwRéf - FirstRwRéf, 1).Value

        For LD = 1 To UBound(TabRef, 1): Dic(CDbl(TabRef(LD, 1))) = Empty: Next LD 'convertie en nombre la colonne "Col1" de "sheet1"
      
        TabRef = Sheets("Sheet2").UsedRange.Value 'charge les valeurs de "sheet2"
      
        For LD = 2 To UBound(TabRef, 1)
            If Dic.Exists(TabRef(LD, 2)) Then
          
            End If
        Next

Si j'ai bien compris le premier for convertie en nombre ma colonne qui est en texte dans la sheet1 (cela plante avant d'avoir fait toute la liste à cause d'une incompatibilité) => je viens de comprendre que c'est parceque la case est vide, j'ai egalement l'erreur car jai un nombre 044661/30. Comment gérer cela?

Le prochain for je n'ai pas encore compris.
 
Dernière édition:

Discussions similaires

Réponses
12
Affichages
507
Réponses
2
Affichages
129