Accélérer le traitement de comparaison de 2 feuilles

Question

Bonjour,

J'utilise le code de Galopin pour comparer 2 feuilles Excel.
Le problème étant que chaque feuille peut atteindre 350 000 lignes et donc la macro est très très lente (25 min environ).

Je voulais savoir si quelqu'un pouvait m'aider à optimiser le code SVP.

Contexte: 
 
Comparaison de 2 fichiers txt que j'importe manuellement sur Excel. 
Ces fichiers ne sont pas ordonnés à l'identique mais possèdent exctement la même structure en colonnes et doivent contenir strictement les mêmes lignes. 
 
Objectif: 
 
Détecter les lignes, du premier fichier txt importé, qui sont absentes dans le second. 

La macro semble bien tourner sur un certain nombre de lignes mais le problème est que les fichiers peuvent aller jusqu'à 350 000 lignes!!!

PS: Je suis débutant en VBA 
Merci d'avance et si pas de réponse je remercie encore une fois Galopin ainsi que tous ceux qui partagent leurs codes. 


 
Sub Comparaison() 
     
    Dim nbLigneAIA As Long 
    Dim nbLigneCRI As Long 
     
    ' ------------  Compteurs de boucles - - - - - - - - - - - - 
     
    Dim i As Long 
    Dim j As Long 
    Dim nbCol As Integer 
     
    ' ------------  Booléens - - - - - - - - - - - - 
    Dim Y As Boolean 
 
    Dim WbA As Workbook, WbN As Workbook 
    Dim WsA As Worksheet, WsN As Worksheet 
  
     
    Set WbA = Workbooks("Automatisation_RQT.xlsm" ) 
    Set WbN = Workbooks("Automatisation_RQT.xlsm" ) 
    Set WbData = Workbooks("Automatisation_RQT.xlsm" ) 
    Set WsA = WbA.Worksheets("Req_AIA" ) 
    Set WsN = WbN.Worksheets("Req_CRI" ) 
     
  'Détermination du nombre de ligne de Classeur "AIA" et "CRI" 
  ' ILRA = WsA.Cells(65535, 1).End(xlUp).Row / Ne marche pas pour un fichier dépassant la taille max (ex: Excel 2007) 
  ' ILRB = WsN.Cells(65535, 1).End(xlUp).Row / Ne marche pas pour un fichier dépassant la taille max (ex: Excel 2007) 
   
    With Sheets("Req_AIA" ) 
        nbLigneAIA = .Range("B" & .Rows.Count).End(xlUp).Row 
    End With 
  
    With Sheets("Req_CRI" ) 
        nbLigneCRI = .Range("B" & .Rows.Count).End(xlUp).Row 
    End With 
    
  ' L'utilisateur choisit le nombre de colonnes à comparer 
   nbCol = Workbooks("Automatisation_RQT.xlsm" ).Sheets("Donnees" ).Range("B1" ).Value + 1 
    
   ' Initialisation des booléens 
    Y = False 
       
     
   'Détermination des absents 
    For i = 2 To nbLigneAIA 
        Y = False 
        For j = 2 To nbLigneCRI          
            If WsA.Cells(i, 2) = WsN.Cells(j, 2) Then 
                'Si égalité alors on pose un drapeau 
                Y = True 
                WsA.Cells(i, 2).Interior.ColorIndex = 4 
                'et on vérifie la ligne si c'est une égalité stricte 
                For k = 3 To nbCol 
                    ' Si égalité alors on colorie la cellule en vert 
                    If WsA.Cells(i, k) = WsN.Cells(j, k) Then 
                       WsA.Cells(i, k).Interior.ColorIndex = 4 
              
                    Else 
                      'Si la cellule en cours n'est pas déjà en vert alors on la met en orange (Eviter l'écrasement de couleur = indiquer la bonne cellule manquante) 
                 
                      If WsA.Cells(i, k).Interior.ColorIndex <> 4 Then 
                         Ys = True 
                         'et on colore en orange 
                         WsA.Cells(i, k).Interior.ColorIndex = 45 
                         Y = False 
                         Exit For 
                      End If 
                    End If 
                Next 
             'Si on trouve la ligne on sort immédiatement du 2 ieme For (éviter de parcours le reste pour rien) 
             If Y Then Exit For 
             End If 
            
        Next 
        
       ' On supprime la ligne trouvée dans les CRI avant de sortir du 2 ieme For (pour minimiser la taille de recherche) 
       ' Et on décrémente la taille du fichier CRI 
        If Y = True Then 
            WsN.Cells(j, 1).EntireRow.Delete 
            nbLigneCRI = nbLigneCRI - 1 
        Else 
            'Si pas trouvé alors on colorie en rouge 
            WsA.Range("B" & i).Interior.ColorIndex = 3 
        End If 
        Y = False 
   Next 
   Set WbA = Nothing 
   Set WbN = Nothing 
   Set WsA = Nothing 
   Set WsN = Nothing 
   End Sub

NHenry · Answer

Bonjour, 

Déclare 2 tableaux de Variant, mets-y les données des 2 plages à vérifier.
Ensuite, compare la valeur de ces tableaux, le gain obtenu sera considérable.

---------------------------------------------------------------------
[list=ordered][*]Pour poser correctement une question et optimiser vos chances d'obtenir des réponses, pensez à lire le règlement CS et aussi ce lien[*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : )
[*]Si votre problème est résolu (et uniquement si c'est le cas), pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés./list
---
Mon site

ucfoutu · Answer

Bonjour,

1)à je plussoie ce qu'en dit NHenry : travailler avec des tableaux estr mille fois plus rapide que de travailler sur des celluls elles-mêmes.
2)
Objectif:

Détecter les lignes, du premier fichier txt importé, qui sont absentes dans le second. 

Je ne comprends pas la nécessite d'importer pour travailler sur ces différences ! Travaille donc directement sur les fichiers textes. Et à ce propos : quelle en est la structure ?


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Soft77 · Answer

Bonjour,

Merci pour la rapidité de vos réponses.

J'avais commencé à travailler avec des tableaux mais j'avais eu un problème à cause du nombre de lignes.
Je vais quand même réessayer.

Concernant le travail sous Excel et non pas sur les fichiers txt directement... je ne sais pas encore le faire et la restitution des résultats me semblait mieux sous Excel.

Je fais ça rapidement et reviens vers vous.

Merci encore.

cs_Jack · Answer

Salut

S'il s'agit de comparer deux fichiers de type texte, pourquoi ne pas utiliser des outils adaptés, comme l'excellent WinMerge

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

Soft77 · Answer

Rebonjour,

Comme conseillé, j'ai eu recours aux tableaux.

Par contre, dans ma macro, à chaque fois que je trouve une ligne je la supprime dans mon fichier de recherche ce qui permet de réduire progressivement la taille de recherche.

Donc ma question est sans doute bête mais comment fait-on pour supprimer une ligne d'un tableau (Dim tab as Variant) à partir d'une ligne détectée?

En gros quelque chose qui ressemble à "TabloCRI().Rows(j - 1).Delete"

Merci d'avance

NHenry · Answer

Bonjour, 

non, il y a pas, et c'est déconseillé de changer la taille d'un tableau très souvent, cela consomme des ressources et du temps.

Sinon, 2 solutions :
- Vider la ligne (aucunes données utiles)
- Refaire le tableau à partir de la source

Tu peux aussi combiner les 2, par exemple toutes les 100 suppressions, régénérer le tableau.

---------------------------------------------------------------------
[list=ordered][*]Pour poser correctement une question et optimiser vos chances d'obtenir des réponses, pensez à lire le règlement CS et aussi ce lien[*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : )
[*]Si votre problème est résolu (et uniquement si c'est le cas), pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés./list
---
Mon site

ucfoutu · Answer

Bonjour,

ne pas toucher aux tableaux (ils ne doivent être là que pour faciliter et agiliser le travail).
Lors de ce travail sur les tableaux : recenser les lignes à supprimer sur la feuille de calcul (constituer en fait une plage PLAGE et l'incrémenter au fur et à mesure par la méthode Union).
In Fine : utiliser cette plage PLAGE pour supprimer, d'un seul coup, toutes ses lignes (Sheets("....").PLAGE.entirow.delete)
Puis libérer la mémoire (Set PLAGE = Nothing et Erase pour les tableaux)

Cette manière de travailler a le mérite, entre autres, de conserver les mises en forme des lignes restantes

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Soft77 · Answer

Bonjour tout le monde,

Malgré toute ma bonne volonté je suis complètement bloqué.

J'ai essayé avec les tableaux mais impossible de faire tourner ma macro.

Je suis donc revenu sur l'utilisation des cellules d'autant que je dois supprimer les lignes trouvées pour ne pas prendre en compte les doublons.

La macro que j'affiche tourne bien mais pas sur des fichiers de plus de 100000 lignes.

Si besoin je eux fournir le fichier Excel mais svp.... à l'aide!!!


Sub Comparaison()
    Application.ScreenUpdating = False
    'Application.DisplayAlerts = False
    Dim nbLigneAIA As Long
    Dim nbLigneCRI As Long
    
    ' ------------  Compteurs de boucles - - - - - - - - - - - -
    
    Dim i As Long
    Dim j As Long
    Dim nbCol As Integer
    
    ' ------------  Booléens - - - - - - - - - - - -
    Dim Y As Boolean
   'Dim Ys As Boolean
    
    
    'Dim TabloA(), TabloN()
    
    
    Dim WbA As Workbook, WbN As Workbook
    Dim WsA As Worksheet, WsN As Worksheet
 
    
    Set WbA = Workbooks("Automatisation_RQT.xlsm")
    Set WbN = Workbooks("Automatisation_RQT.xlsm")
    Set WbData = Workbooks("Automatisation_RQT.xlsm")
    Set WsA = WbA.Worksheets("Req_AIA")
    Set WsN = WbN.Worksheets("Req_CRI")
    
  'Détermination du nombre de ligne de Classeur "AIA" et "CRI"
  ' ILRA = WsA.Cells(65535, 1).End(xlUp).Row / Ne marche pas pour un fichier dépassant la taille max (ex: Excel 2007)
  ' ILRB = WsN.Cells(65535, 1).End(xlUp).Row / Ne marche pas pour un fichier dépassant la taille max (ex: Excel 2007)
  
    With Sheets("Req_AIA")
        nbLigneAIA = .Range("B" & .Rows.Count).End(xlUp).Row
    End With
 
    With Sheets("Req_CRI")
        nbLigneCRI = .Range("B" & .Rows.Count).End(xlUp).Row
    End With
   
  ' L'utilisateur choisit le nombre de colonnes à comparer
   nbCol = Workbooks("Automatisation_RQT.xlsm").Sheets("Donnees").Range("B1").Value + 1
   
   ' Initialisation des booléens
    Y = False
   'Ys = False
    
    'Accélérateur de Macro
    'Call ini_sub
    
    'Appel à la fonction de Tri
    'Call Tri_criteres
    
    'Appel à la fonction de suppression des blancs
    'Call SupprEspaces
    
   'Détermination des absents
    For i = 2 To nbLigneAIA
    'If IsEmpty(WsA.Cells(i, 1).Value) Then GoTo AIA
        Y = False
        For j = 2 To nbLigneCRI
        'If IsEmpty(WsN.Cells(j, 1).Value) And j > ILRB Then GoTo CRI
        
            If WsA.Cells(i, 2) = WsN.Cells(j, 2) Then
                'Si égalité alors on pose un drapeau
                Y = True
                WsA.Cells(i, 2).Interior.ColorIndex = 4
                'et on vérifie la ligne si c'est une égalité stricte
                For k = 3 To nbCol
                    ' Si égalité alors on colorie la cellule en vert
                    If WsA.Cells(i, k) = WsN.Cells(j, k) Then
                       WsA.Cells(i, k).Interior.ColorIndex = 4
             
                    Else
                      'Si la cellule en cours n'est pas déjà en vert alors on la met en orange (Eviter l'écrasement de couleur = indiquer la bonne cellule manquante)
                
                      If WsA.Cells(i, k).Interior.ColorIndex <> 4 Then
                         Ys = True
                         'et on colore en orange
                         WsA.Cells(i, k).Interior.ColorIndex = 45
                         Y = False
                         Exit For
                      End If
                    End If
                Next
             'sinon 1ere cellule en vert
             'WsN.Cells(j, 1).Interior.ColorIndex = IIf(Ys, 45, 4)
             'WsA.Cells(i, 1).Interior.ColorIndex = IIf(Ys, 45, 4)
             'Ys = False
             
             'Si on trouve la ligne on sort immédiatement du 2 ieme For (éviter de parcours le reste pour rien)
             If Y Then Exit For
             End If
           
        Next
       
       ' On supprime la ligne trouvée dans les CRI avant de sortir du 2 ieme For (pour minimiser la taille de recherche)
       ' Et on décrémente la taille du fichier CRI
        If Y = True Then
            WsN.Cells(j, 1).EntireRow.Delete
            nbLigneCRI = nbLigneCRI - 1
        Else
            'Si pas trouvé alors on colorie en rouge
            WsA.Range("B" & i).Interior.ColorIndex = 3
        End If
        Y = False
   Next
   
'AIA: MsgBox ("L'Onglet AIA est FINI")
'GoTo FIN
'CRI: MsgBox ("L'Onglet CRI est VIDE ou TERMINE ---> Fin de recherche!!!")
   MsgBox ("FIN DE TRAITEMENT")
   Set WbA = Nothing
   Set WbN = Nothing
   Set WsA = Nothing
   Set WsN = Nothing
   
   'Call fin_sub
   End Sub

ucfoutu · Answer

J'ai essayé avec les tableaux mais impossible de faire tourner ma macro. 


Bon ! montre comment tu l'as fait, donc 
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Soft77 · Answer

Comme demandé voila le code avec les tableaux Sub Comparaison() Dim nbLigneAIA As Long Dim nbLigneCRI As Long ' ------------ Compteurs de boucles - - - - - - - - - - - - Dim i As Long Dim j As Long Dim nbCol As Integer ' ------------ Booléens - - - - - - - - - - - - Dim Y As Boolean 'Dim Ys As Boolean Dim WbA As Workbook, WbN As Workbook Dim WsA As Worksheet, WsN As Worksheet Set WbA = Workbooks("Automatisation_RQT_V2.xlsm") Set WbN = Workbooks("Automatisation_RQT_V2.xlsm") Set WbData = Workbooks("Automatisation_RQT_V2.xlsm") Set WsA = WbA.Worksheets("Req_AIA") Set WsN = WbN.Worksheets("Req_CRI") 'Détermination du nombre de ligne de Classeur "AIA" et "CRI" ' ILRA = WsA.Cells(65535, 1).End(xlUp).Row / Ne marche pas pour un fichier dépassant la taille max (ex: Excel 2007) ' ILRB = WsN.Cells(65535, 1).End(xlUp).Row / Ne marche pas pour un fichier dépassant la taille max (ex: Excel 2007) With Sheets("Req_AIA") nbLigneAIA = .Range("B" & .Rows.Count).End(xlUp).Row End With With Sheets("Req_CRI") nbLigneCRI = .Range("C" & .Rows.Count).End(xlUp).Row End With 'L 'utilisateur choisit le nombre de colonnes à comparer nbCol = Workbooks("Automatisation_RQT_V2.xlsm").Sheets("Donnees").Range("B1").Value + 1 ' ------------ Tableaux - - - - - - - - - - - - Dim TabloAIA() As Variant Dim TabloCRI() As Variant ReDim TabloAIA(nbLigneAIA, nbCol) ReDim TabloCRI(nbLigneCRI, nbCol) ' Initialisation des booléens Y = False TabloAIA() = WsA.Range("A2:D" & nbLigneAIA) TabloCRI() = WsN.Range("A2:F" & nbLigneCRI) 'Détermination des absents For i = 2 To nbLigneAIA 'UBound(TabloAIA) Y = False For j = 2 To nbLigneCRI 'UBound(TabloCRI) ' Tester si la ligne n'a pas déjà été trouvée avant 'If WsN.Cells(j, 2).Value <> "" Then 'If WsA.Cells(i, 2) = WsN.Cells(j, 2) Then If TabloAIA(i - 1, 2) = TabloCRI(j - 1, 3) Then 'Si égalité alors on pose un drapeau Y = True WsA.Cells(i, 2).Interior.ColorIndex = 4 'et on vérifie la ligne si c'est une égalité stricte For k = 3 To nbCol ' Si égalité alors on colorie la cellule en vert 'If WsA.Cells(i, k) = WsN.Cells(j, k) Then If TabloAIA(i - 1, k - 1) = TabloCRI(j - 1, k) Then WsA.Cells(i, k).Interior.ColorIndex = 4 Else 'Si la cellule en cours n'est pas déjà en vert alors on la met en orange (Eviter l'écrasement de couleur = indiquer la bonne cellule manquante) If WsA.Cells(i, k).Interior.ColorIndex <> 4 Then 'Ys = True 'et on colore en orange WsA.Cells(i, k).Interior.ColorIndex = 45 Y = False Exit For End If Next End If 'End If 'Si on trouve la ligne on sort immédiatement du 2 ieme For (éviter de parcours le reste pour rien) If Y Then Exit For End If Next ' On supprime la ligne trouvée dans les CRI avant de sortir du 2 ieme For (pour minimiser la taille de recherche) ' Et on décrémente la taille du fichier CRI If Y = True Then 'WsN.Cells(j, 1).EntireRow.Delete 'TabloCRI().Rows(j - 1).Delete 'nbLigneCRI = nbLigneCRI - 1 'ReDim Preserve TabloCRI(nbLigneCRI, nbCol) 'On colorie la ligne CRI en vert WsN.Cells(j, 3).Interior.ColorIndex = 4 'On enregistre le numéro de ligne AIA sur la ligne CRI trouvée (Correspondance) WsN.Cells(j, 2).Value = i Else 'Si pas trouvé alors on colorie la ligne AIA en rouge WsA.Range("B" & i).Interior.ColorIndex = 3 End If Y = False Next Erase TabloAIA Erase TabloCRI Set WbA = Nothing Set WbN = Nothing Set WsA = Nothing Set WsN = Nothing End Sub Si quelqu'un est motivé pour un petit,coup de pouce je peux envoyer les 2 versions en MP. Merci ;)

ucfoutu · Answer

Déjà :
 With Sheets("Req_AIA")
        nbLigneAIA = .Range("B" & .Rows.Count).End(xlUp).Row
    End With
 
    With Sheets("Req_CRI")
        nbLigneCRI = .Range("C" & .Rows.Count).End(xlUp).Row
    End With
ne peut fonctionner normalement puisquer les deux feuilles se trouvent dans des classeurs différents !
Pourquoi ne pas utiliser les deux objets que tu as définis, à savoir :
Set WsA = WbA.Worksheets("Req_AIA")
    Set WsN =  WbN.Worksheets("Req_CRI")

Je m'arrête là  pour l'instant 

____________________
Réponse exacte ?  => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Soft77 · Answer

Il y a 3 onglets dans le même classeur:

- Donnees (l'utilisateur donne le nombre de colonnes à comparer: ce nombre est récupéré dans la variable nbCol)
- Req_AIA
- Req_CRI

ucfoutu · Answer

Oui ?
Et qu'est-ce que cela change de ce que j'ai pointé du doigt ? ===>> Rien !


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Soft77 · Answer

Effectivement rien.
Mais avec les tests "pas à pas" je n'ai pas d'erreurs à ce niveau mais tu as raison je vais plutôt utiliser les 2 objets que j'ai créé.

galopin01 · Answer

Bonjour,
J'ai répondu à ce sujet dans le forum d'origine.
Bien sur le code fourni n'est pas de moi mais un code aménagé maladroitement par soft77.
Bien sur il fallait reprendre l'intégralité du code d'origine qui comportait des Array et ne comportait ni Delete ni Redim... 
Il suffisait de modifier les variables en Long -ce qui a bien été fait- 
Modifier la définition des variables ILRA et ILRB à la manière de nbLigneAIA 
Compter environ 2 minutes pour 350 000 lignes et 50 colonnes...
A+

Soft77 · Answer

Salut galopin01,
Merci d'avoir répondu à mon post. Effectivement j'ai certainement du mal utiliser ton code miasme fois absolument supprimer les lignes trouvées d'ou l'abandon des tableaux. Est ce que tu peux m'aider a ce sujet stp? J'ai vraiment besoin d'aider car bloqué depuis mon dernier msg. Merci d'avance et comme je l'ai précisée je peux fournir le fichier en privé du besoin.

Soft77 · Answer

Bonjour, Voici le code refait avec des tableaux. A présent, au lieu de supprimer les lignes trouvées, j'indique directement sur l'onglet de recherche les lignes trouvées afin d'éviter de laisser passer les doublons. Par contre, j'ai toujours un problème de temps d'exécution A l'aide svp Sub Comparaison() Dim nbLigneAIA As Long Dim nbLigneCRI As Long ' ------------ Compteurs de boucles - - - - - - - - - - - - Dim i As Long Dim j As Long Dim nbCol As Integer ' ------------ Booléens - - - - - - - - - - - - Dim Y As Boolean Dim WbA As Workbook, WbN As Workbook Dim WsA As Worksheet, WsN As Worksheet ' ------------ Initialisation Workbook et Sheets - - - - - - - - - - - - Set WbA = Workbooks("Automatisation_RQT_V2.xlsm") Set WbN = Workbooks("Automatisation_RQT_V2.xlsm") Set WbData = Workbooks("Automatisation_RQT_V2.xlsm") Set WsA = WbA.Worksheets("Req_AIA") Set WsN = WbN.Worksheets("Req_CRI") ' ------------ Détermination des tailles des 2 fichiers - - - - - - - - - - - - With Sheets("Req_AIA") nbLigneAIA = .Range("B" & .Rows.Count).End(xlUp).Row End With With Sheets("Req_CRI") nbLigneCRI = .Range("B" & .Rows.Count).End(xlUp).Row End With 'L 'utilisateur choisit le nombre de colonnes à comparer nbCol = Workbooks("Automatisation_RQT_V2.xlsm").Sheets("Donnees").Range("B1").Value + 1 ' ------------ Tableaux - - - - - - - - - - - - Dim TabloAIA() As Variant Dim TabloCRI() As Variant ' Initialisation des booléens Y = False TabloAIA() = WsA.Range("B2:Q" & nbLigneAIA) TabloCRI() = WsN.Range("B2:Q" & nbLigneCRI) 'TabloAIA() = WsA.Range(Cells(1, 1), Cells(nbLigneAIA, nbCol + 1)) 'TabloCRI() = WsN.Range(Cells(1, 1), Cells(nbLigneCRI, nbCol + 1)) 'Détermination des absents For i = 2 To nbLigneAIA Y = False For j = 2 To nbLigneCRI ' Tester si la ligne n'a pas déjà été trouvée avant If WsN.Cells(j, nbCol + 1) <> "Trouvé" Then If TabloAIA(i - 1, 1) = TabloCRI(j - 1, 1) Then 'Si égalité alors on pose un drapeau Y = True WsA.Cells(i, 2).Interior.ColorIndex = 4 'et on vérifie la ligne si c'est une égalité stricte For k = 3 To nbCol ' Si égalité alors on colorie la cellule en vert 'If WsA.Cells(i, k) = WsN.Cells(j, k) Then If TabloAIA(i - 1, k - 1) = TabloCRI(j - 1, k - 1) Then WsA.Cells(i, k).Interior.ColorIndex = 4 Else 'Si la cellule en cours n'est pas déjà en vert alors on la met en orange (Eviter l'écrasement de couleur = indiquer la bonne cellule manquante) If WsA.Cells(i, k).Interior.ColorIndex <> 4 Then 'Ys = True 'et on colore en orange WsA.Cells(i, k).Interior.ColorIndex = 45 Y = False Exit For End If End If Next End If 'Si on trouve la ligne on sort immédiatement du 2 ieme For (éviter de parcours le reste pour rien) If Y Then Exit For End If Next If Y = True Then 'Marquer dans le fichier CRI les lignes trouvées pour éviter de laisser passer les doublons WsN.Cells(j, nbCol + 1) = "Trouvé" Else 'Si pas trouvé alors on colorie la ligne AIA en rouge WsA.Range("B" & i).Interior.ColorIndex = 3 End If Y = False Next Erase TabloAIA Erase TabloCRI Set WbA = Nothing Set WbN = Nothing Set WsA = Nothing Set WsN = Nothing End Sub

ucfoutu · Answer

Bonjour,

Tes tableaux ne servent plus vraiment d'accélérateurs si tu ralentis par ailleurs en bouclant sur des cellules !
C'est sur un tableau et non sur des cellules, que tu dois boucler, si tu veux profiter de la formidable vitesse d'utilisation qu'offre un travail sur tableau dynamique.
Je t'invite à relire attentivement mon message du mardi 11 octobre 2011 à 07:47:24 
Il te parle de plages à constituer (à partir de tes tableaux) et à utiliser en bloc à la fin.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Accélérer le traitement de comparaison de 2 feuilles

18 réponses

Votre réponse

Discussions similaires