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

Soft77 Messages postés 9 Date d'inscription dimanche 23 octobre 2011 Statut Membre Dernière intervention 23 octobre 2011 - 10 oct. 2011 à 12:47
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 - 17 oct. 2011 à 18:45
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
 

18 réponses

NHenry Messages postés 15025 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 26 novembre 2022 157
10 oct. 2011 à 13:18
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
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 231
10 oct. 2011 à 14:06
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
0
Soft77 Messages postés 9 Date d'inscription dimanche 23 octobre 2011 Statut Membre Dernière intervention 23 octobre 2011
10 oct. 2011 à 15:42
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.
0
cs_Jack Messages postés 14007 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 78
10 oct. 2011 à 16:53
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)
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Soft77 Messages postés 9 Date d'inscription dimanche 23 octobre 2011 Statut Membre Dernière intervention 23 octobre 2011
10 oct. 2011 à 21:22
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
0
NHenry Messages postés 15025 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 26 novembre 2022 157
10 oct. 2011 à 22:18
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
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 231
11 oct. 2011 à 07:47
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
0
Soft77 Messages postés 9 Date d'inscription dimanche 23 octobre 2011 Statut Membre Dernière intervention 23 octobre 2011
11 oct. 2011 à 18:33
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
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 231
11 oct. 2011 à 19:35
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
0
Soft77 Messages postés 9 Date d'inscription dimanche 23 octobre 2011 Statut Membre Dernière intervention 23 octobre 2011
12 oct. 2011 à 11:27
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 ;)
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 231
12 oct. 2011 à 11:34
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
0
Soft77 Messages postés 9 Date d'inscription dimanche 23 octobre 2011 Statut Membre Dernière intervention 23 octobre 2011
12 oct. 2011 à 12:17
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
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 231
12 oct. 2011 à 13:12
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
0
Soft77 Messages postés 9 Date d'inscription dimanche 23 octobre 2011 Statut Membre Dernière intervention 23 octobre 2011
12 oct. 2011 à 20:12
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éé.
0
galopin01 Messages postés 133 Date d'inscription lundi 4 octobre 2004 Statut Membre Dernière intervention 14 octobre 2011 1
14 oct. 2011 à 19:42
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+
0
Soft77 Messages postés 9 Date d'inscription dimanche 23 octobre 2011 Statut Membre Dernière intervention 23 octobre 2011
15 oct. 2011 à 16:46
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.
0
Soft77 Messages postés 9 Date d'inscription dimanche 23 octobre 2011 Statut Membre Dernière intervention 23 octobre 2011
17 oct. 2011 à 16:51
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
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 231
17 oct. 2011 à 18:45
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
0