[Besoin de méthode d'optimisation de temps de traitement, macro VBA][RESOLU]

Thibault LB

XLDnaute Junior
Bonjour à tous,

Je vous explique ma problématique.
Chaque mois un fichier excel est extrait d'une base de données. J'ai besoin de faire une comparaison entre le fichier d'un mois, avec celui du mois précédent. Pour cela, je veux que les cellules qui ont changées soit coloriées en jaune, et si une ligne a été insérée, que toute la ligne soit en jaune, tout ça dans le nouveau fichier.

Ma macro marche très bien. Sauf que les fichiers excel en question font plus de 3700 lignes (pour 37 colonnes), et mon traitement n'arrive jamais au bout (j'ai deja laissé mouliner 1h). J'ai donc fait mes tests finaux sur un fichier redressé a 50 lignes. La fonctionnalité est la, tout marche très bien, avec une résolution immédiate et parfaite, mais le temps de traitement ne me permet pas de l'étendre aux vrais fichiers.

Je me suis dis que peut-être auriez-vous des méthodes pour optimiser un code VBA ?

Voici le code, avec mes explications ci-après :

Code:
'Macro permettant de mettre à jour les données France pour chaque onglet, onglet par onglet.
Sub Difference()
'Raccourci clavier : Ctrl + e
'
'Par Thibault Le Bouter

Application.ScreenUpdating = False

'Récupération du fichier actif (depuis lequel on lance la macro) et enregistrement dans l'objet Nouveau.
Dim Nouveau As Workbook
Dim nom As String
nom = ActiveWorkbook.Name
Set Nouveau = Workbooks("" & nom)

'Récupération du fichier avec lequel on veut comparer, par une invite utilisateur. Le fichier est stocké dans l'objet Ancien.
Dim Ancien As Workbook
Dim AN As Variant
AN = Application.GetOpenFilename(FileFilter:="Fichiers Excel (*.xl*), *.xl*", Title:="Choix du fichier de comparaison")
If AN <> False Then
    Set Ancien = Workbooks.Open(AN)
End If

Dim i As Long
Dim Valeur As String
Dim Valeur2 As String
Valeur = ""
Valeur2 = ""

Ancien.Worksheets("global").Activate
Last2 = Cells(65536, 2).End(xlUp).Row 'Récupération de la dernière ligne non vide de l'ancien fichier et stockage dans le variable Last2
For J = 5 To Last2
    'Concaténation de toutes les colonnes, lignes par lignes.
    Cells(J, 38).Value = Cells(J, 2).Value & Cells(J, 3).Value & Cells(J, 4).Value & Cells(J, 5).Value & Cells(J, 6).Value & Cells(J, 7).Value & Cells(J, 8).Value & Cells(J, 9).Value & Cells(J, 10).Value & Cells(J, 11).Value & Cells(J, 12).Value & Cells(J, 13).Value & Cells(J, 14).Value & Cells(J, 15).Value & Cells(J, 16).Value & Cells(J, 17).Value & Cells(J, 18).Value & Cells(J, 19).Value & Cells(J, 20).Value & Cells(J, 21).Value & Cells(J, 22).Value & Cells(J, 23).Value & Cells(J, 24).Value & Cells(J, 25).Value & Cells(J, 26).Value & Cells(J, 27).Value & Cells(J, 28).Value & Cells(J, 29).Value & Cells(J, 30).Value & Cells(J, 31).Value & Cells(J, 32).Value & Cells(J, 33).Value & Cells(J, 34).Value & Cells(J, 35).Value & Cells(J, 36).Value & Cells(J, 37).Value
Next J
Columns("AL").AutoFit

Nouveau.Worksheets("global").Activate
Last = Cells(65536, 2).End(xlUp).Row 'Récupération de la dernière ligne non vide du nouveau fichier et stockage dans le variable Last
For J = 5 To Last
    'Concaténation de toutes les colonnes, lignes par lignes.
    Cells(J, 38).Value = Cells(J, 2).Value & Cells(J, 3).Value & Cells(J, 4).Value & Cells(J, 5).Value & Cells(J, 6).Value & Cells(J, 7).Value & Cells(J, 8).Value & Cells(J, 9).Value & Cells(J, 10).Value & Cells(J, 11).Value & Cells(J, 12).Value & Cells(J, 13).Value & Cells(J, 14).Value & Cells(J, 15).Value & Cells(J, 16).Value & Cells(J, 17).Value & Cells(J, 18).Value & Cells(J, 19).Value & Cells(J, 20).Value & Cells(J, 21).Value & Cells(J, 22).Value & Cells(J, 23).Value & Cells(J, 24).Value & Cells(J, 25).Value & Cells(J, 26).Value & Cells(J, 27).Value & Cells(J, 28).Value & Cells(J, 29).Value & Cells(J, 30).Value & Cells(J, 31).Value & Cells(J, 32).Value & Cells(J, 33).Value & Cells(J, 34).Value & Cells(J, 35).Value & Cells(J, 36).Value & Cells(J, 37).Value
Next J
Columns("AL").AutoFit

If Last > Last2 Then 'Determination de la taille necessaire du tableau
    Dernier = Last
Else
    Dernier = Last2
End If

'Intialisation d'un tableau de la taille du nombres maximum de lignes (Possibilité de 5000 lignes max)
Dim NomTableau(5000) As Integer
For K = 0 To Dernier
    NomTableau(K) = 0
Next K

'Suppression de possible coloriage de cellule précédemment fait (utile par exemple lors d'une erreur de fichier à comparer, ou s'il on veut comparer avec un autre fichier.
For i = 5 To Last
Nouveau.Worksheets("global").Activate
Range("" & i & ":" & i).Interior.ColorIndex = xlAutomatic
Next i

Nouveau.Worksheets("global").Activate


For i = 5 To Last
    Valeur_Test = Nouveau.Worksheets("global").Cells(i, 38).Value 'La valeur qu'on souhaite tester (test sur la valeur précédemment concaténée)
    For numLigne = 5 To Last2 'Boucle for déroulant les cellules concaténées de l'autre fichier.
'On verifie si la valeur Valeur_Test du nouveau fichier est contenue dans l'ancien
        If Ancien.Worksheets("global").Cells(numLigne, 38).Value = Valeur_Test Then
            NomTableau(i) = 0 'Si la valeur est trouvée, on met la ligne du tableau a 0...
            Exit For '...et on arrête la boucle.
        Else
            v = Nouveau.Worksheets("global").Cells(i, 4).Value 'Test sur une colonne a champ unique, pour voir si la ligne existe quand même.
            For numLigne2 = 5 To Last2
                If Ancien.Worksheets("global").Cells(numLigne2, 4).Value = v Then
                    NomTableau(i) = numLigne2   'Si trouvé, on insère le numéro de ligne dans le tableau.
                    Exit For
                Else
                    NomTableau(i) = -1 'Si le code article n'a pas été trouvé, on associe la case a -1 pour traitement plus tard.
                    'Nouveau.Worksheets("global").Range("" & i & ":" & i).Select 'On selectionne les lignes n'étant pas du tout présente dans l'ancien fichier...
                    'Selection.Interior.ColorIndex = 6 '...et on leur associe la couleur jaune.
                End If
            Next numLigne2
        End If
    Next numLigne
Next i




For J = 5 To Dernier 'On déroule le tableau pour récupérer tous les numéros de lignes enregistrés
If NomTableau(J) <> -1 Then
    If NomTableau(J) <> 0 Then 'Si le tableau n'est pas égal à 0 à la case j...
        For c = 2 To 37 '... on parcourt toutes les colonnes pour repérer en quelle(s) cellule(s) il y a différence.
            Valeur = Nouveau.Worksheets("global").Cells(J, c).Value
            'For Each cel In Range("" & NomTableau(J) & ":" & NomTableau(J))
                Valeur2 = Ancien.Worksheets("global").Cells(NomTableau(J), c).Value
                If Valeur <> Valeur2 Then 'Si
                    Nouveau.Worksheets("global").Cells(J, c).Interior.ColorIndex = 6 '...on associe la couleur jaune a la cellule
                End If
                Valeur = "" 'On reinitialise les variables
                Valeur2 = ""
        Next c
    End If
Else 'Si case -1, c'est que la ligne est nouvelle, donc a mettre entierement en jaune.
    Nouveau.Worksheets("global").Range("" & J & ":" & J).Select 'On selectionne les lignes n'étant pas du tout présente dans l'ancien fichier...
    Selection.Interior.ColorIndex = 6 '...et on leur associe la couleur jaune.
End If
Next J




''Même procédure pour le second onglet.
'Ancien.Worksheets("Par code vrac").Activate
'Last3 = Cells(65536, 2).End(xlUp).Row
'For J = 5 To Last2
'    Cells(J, 39).Value = Cells(J, 8).Value & Cells(J, 9).Value & Cells(J, 10).Value & Cells(J, 11).Value & Cells(J, 12).Value & Cells(J, 13).Value & Cells(J, 14).Value & Cells(J, 15).Value & Cells(J, 16).Value & Cells(J, 17).Value & Cells(J, 18).Value & Cells(J, 19).Value & Cells(J, 20).Value & Cells(J, 21).Value & Cells(J, 22).Value & Cells(J, 23).Value & Cells(J, 24).Value & Cells(J, 25).Value & Cells(J, 26).Value & Cells(J, 27).Value & Cells(J, 28).Value & Cells(J, 29).Value & Cells(J, 30).Value & Cells(J, 31).Value & Cells(J, 32).Value & Cells(J, 33).Value & Cells(J, 34).Value & Cells(J, 35).Value & Cells(J, 36).Value & Cells(J, 37).Value & Cells(J, 38).Value
'Next J
'Columns("AM").AutoFit
'
'Nouveau.Worksheets("Par code vrac").Activate
'Last4 = Cells(65536, 2).End(xlUp).Row
'For J = 5 To Last
'    Cells(J, 39).Value = Cells(J, 8).Value & Cells(J, 9).Value & Cells(J, 10).Value & Cells(J, 11).Value & Cells(J, 12).Value & Cells(J, 13).Value & Cells(J, 14).Value & Cells(J, 15).Value & Cells(J, 16).Value & Cells(J, 17).Value & Cells(J, 18).Value & Cells(J, 19).Value & Cells(J, 20).Value & Cells(J, 21).Value & Cells(J, 22).Value & Cells(J, 23).Value & Cells(J, 24).Value & Cells(J, 25).Value & Cells(J, 26).Value & Cells(J, 27).Value & Cells(J, 28).Value & Cells(J, 29).Value & Cells(J, 30).Value & Cells(J, 31).Value & Cells(J, 32).Value & Cells(J, 33).Value & Cells(J, 34).Value & Cells(J, 35).Value & Cells(J, 36).Value & Cells(J, 37).Value & Cells(J, 38).Value
'Next J
'Columns("AM").AutoFit



End Sub

Pour faire court :
1) Je concatène les 37 colonnes de chaque ligne
2) Je fais mes boucles sur chaque ligne, pour vérifier si les champs concaténés sont présents dans l'ancien fichier. Si une cellule a changé dans la ligne, elle apparaitra différent (ATTENTION : les lignes peuvent ne pas être au même endroit d'un mois sur l'autre, il peut y avoir des insertions ou des suppressions, donc je dois bien regarder toutes les lignes pour chaque ligne (sauf s'il elle est trouvé, pas de doublons possible).).
3) Une fois que j'ai récupérer les lignes contenant une difference, je regarde pour chaque cellule, si elle est identique (les colonnes ne bouge pas en revanche, toujours dans le même ordre).

Si vous avez des questions, n'hesitez pas.

Thibault.
 
Dernière édition:

flyonets44

XLDnaute Occasionnel
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Bonjour
tu peux mettre en début de macro
Application.Calculation = xlCalculationManual
et en fin de macro
Application.Calculation = xlCalculationautomatic
çà devrait notablement accélerer ton temps de traitement
Autre solution stocker ta concaténation dans un tableau ou
un dictionnaire pour le traiter
enfin pourquoi cette instruction sachant qu'un tableau à sa création est vide
Dim NomTableau(5000) As Integer ok
For K = 0 To Dernier inutile
NomTableau(K) = 0 inutile
Next K inutile
Cordialement
Flyonets
 

Thibault LB

XLDnaute Junior
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Bonjour fly,

Tout d'abord, merci de ta réponse. Je n'ai pas pu répondre avant, car c'est une problématique professionnelle, que je n'ai pas le temps de gérer le week-end.

J'ai ajouté les deux instructions en début et fin de macro. Mais peux-tu me dire concretement ce que ça change, juste pour informations personnelles ?

Sinon, le temps de traitement est toujours extremement long, la macro tourne encore en ce moment.

Donc si n'importe qui d'autre aurait des solutions, je suis toujours plus que preneur.

Cordialement,
Thibault
 

Vorens

XLDnaute Occasionnel
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Hello tous le monde.


Il existe plusieurs chose qui peut te permette d'augmenter la vitesse du code.

1) optimiser ton code car visiblement, il est trop lourd ton code donc y'a surement moyen d'optimiser tout cela (utilise les balises code disponible dans la barre d'outil lors de l'édition d'un message. Cela va le rendre plus lisible pour nous).

2) Utiliser la ligne de code proposé par notre ami Flyounet. Cette commande désactive les calcules automatiques dExcel (mise a jours des valeurs résultant des formules) En gros, excel ne calcule plus si ta macro modifie beaucoup de cellule qui sont utilisée dans tes formules, chaque fois qu'une valeur est changée Excel recalcule le résultat donc bcp de calcule durant l’exécution du code donc c'est lent.

3) Il te faut désactiver l'affichage d'excel, l'affichage ralenti énormément l’exécution d'une macro. Pour cela, utiliser la commande suivante:

En début de procédure:

Code:
Application.ScreenUpdating = False

En fin de procèdure:

Code:
Application.ScreenUpdating = True

4) Eviter à tout prix les patatitpatata.ACTIVATE ou les .SELECT Cela ralenti aussi l’exécution du code inutilement. On va préférer aller pointer directement dans la feuille. Je reprend ton code par exemple pour

Ancien.Worksheets("global").Activate
Last2 = Cells(65536, 2).End(xlUp).Row 'Récupération de la dernière ligne non vide de l'ancien fichier et stockage dans le variable Last2

On va préférer soit utiliser la propriété WITH ou alors directement écrire la ligne avec l'adresse (cela faire partie de l’optimisation du code)

Exemple 1:

Code:
With ThisWorkbook.Sheets("global")

toto = .Range("A" & "65535").End(xlups).Row

End With

Exemple 2:

Code:
toto = ThisWorkbook.Sheets("global").Range("A" & "65535").End(xlups).Row

Le With est bien pratique lors que tu as plusieurs opération à faire dans la même feuille. sa t'évite de chaque fois écrire ThiseWorkbook.sheets.LeReste

5) Privilégier le Value à value plutôt que le copy / paste Par exemple, si tu veux passer le range A2:A12 de la feuille 1 vers l1 range B2:B12 de la feuille 2

Il faut faire comme suit:

Code:
ThisWorkbook.Sheets("Feuil2").Range("B2:B12").Value = ThisWorkbook.Sheets("Feuil1").Range("A2:A12").Value

Plutôt que faire cela:

Code:
ThisWorkbook.Sheets("Feuil2").Range("B2:B12").Copy

ThisWorkbook.Sheets("Feuil1").Range("B2").Paste

Voila, j'ai surement oublier des trucs mais y'a déjà de quoi travailler.

C'est important de bien optimiser son code lorsque on commence à avoir bcp de traitement avec une macro Excel.

J’espère avoir pus t'aider.

Meilleures salutations

Vorens
 

Dranreb

XLDnaute Barbatruc
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Bonjour.
Ny a-t-il pas une information, ne serait-ce qu'un groupe très restreint de quelques colonnes, qui pourraient servir à identifier chaque lignes dans les 2 fichiers ? Ce serait plus simple à traiter. Ça n'empêcherait pas de vérifier si les autres colonnes des lignes ayant même identifiant diffèrent ou non.
De toute façon joignez votre fichier.
À +
 

Thibault LB

XLDnaute Junior
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Merci pour vos réponses, et bonjour à vous deux.

1) J'édite mon premier message avec la balise code, merci de l'info.

2) Ajout des lignes proposé par Flyounet

3) J'avais deja eu cette info vu dans un autre topic, ajout effectué également.

Pour le reste, je fais les modifs, et je reviens vers vous dès que possible. Avec les trois optimisations précédents, le temps de traitement est toujours extremement long, attente d'une heure avant annulation pour faire vos modifications.


Pour ce qui est de placer une fichier en pièce jointe, je vais d'abord m'assurer de la non -confidentialité des données. Je le posterais le cas échéant. Merci pour votre temps.

Thibault.
 

Vorens

XLDnaute Occasionnel
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Re,


Je vois que tu concatène plein de cellule et écrit le résultat dans une cellule. Je t'ai fait une petite fonction qui effectue le même travail. Il te faut par contre l'adapter. Cela peux optimiser ton code et donc l'accélérer.

Code:
Function concat()


Dim c As Range
Dim plage As Range
Dim Val As String   'Resultat de la concaténation

'Active le range a concatener

Set plage = Range("A1:G1")


'Parcourt toute les cellules du range
For Each c In plage

If c.Value <> "" Then

Val = Val & c.Value

End If

Next

concat = Val

End Function

Dans cette exemple, on concatène toute les cellules de la plage A1:G1

Le résulta est stocké dans la variable Val

Je ne sais pas si tu sais utiliser et appeler les fonctions. Dans le doute, tu appel la fonction comme cela:

MonResultat = concat


Le résultat de la fonction sera écrit dans la variable MonResultat

PS:Tu peux entrée dans la fonction avec le range en paramètre. Je l'ai Hardcodé pour l'exemple mais c'est pas comme cela qu'on doit le faire.

Si tu as besoins d'explication sur l'utilisation des fonctions hésite pas, dans le cas contraire tu sais comment entré dans une fonction avec les paramètres.

Meilleure salutations
 

Thibault LB

XLDnaute Junior
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Voila un exemple de fichier en pièce jointe. La macro marche très bien. Mais c'est juste pour vous donner la structure des fichiers. C'est cela, mais avec 3700 lignes.

J'ai fait plusieurs changements :
- Suppression des .Select/.Activate
- Je n'utilise pas de copy/paste.
- Le seul que je n'ai pas effectué est la fonction pour concaténer. Selon moi (dis moi si je me trompe), ta méthode ne peux pas marcher sur mon exemple étant donnée que je concatène les colonnes des 3700 lignes, hors ta fonction ne me retourne qu'une valeur (non?).

Code:
'Macro permettant de mettre à jour les données France pour chaque onglet, onglet par onglet.
Sub Difference()
'Raccourci clavier : Ctrl + e
'
'Par Thibault Le Bouter

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


'Récupération du fichier actif (depuis lequel on lance la macro) et enregistrement dans l'objet Nouveau.
Dim Nouveau As Workbook
Dim nom As String
nom = ActiveWorkbook.Name
Set Nouveau = Workbooks("" & nom)

'Récupération du fichier avec lequel on veut comparer, par une invite utilisateur. Le fichier est stocké dans l'objet Ancien.
Dim Ancien As Workbook
Dim AN As Variant
AN = Application.GetOpenFilename(FileFilter:="Fichiers Excel (*.xl*), *.xl*", Title:="Choix du fichier de comparaison")
If AN <> False Then
    Set Ancien = Workbooks.Open(AN)
End If

Dim i As Long
Dim Valeur As String
Dim Valeur2 As String
Valeur = ""
Valeur2 = ""

Last2 = Ancien.Worksheets("global").Cells(65536, 2).End(xlUp).Row 'Récupération de la dernière ligne non vide de l'ancien fichier et stockage dans le variable Last2
For J = 5 To Last2
    'Concaténation de toutes les colonnes, lignes par lignes.
    Cells(J, 38).Value = Cells(J, 2).Value & Cells(J, 3).Value & Cells(J, 4).Value & Cells(J, 5).Value & Cells(J, 6).Value & Cells(J, 7).Value & Cells(J, 8).Value & Cells(J, 9).Value & Cells(J, 10).Value & Cells(J, 11).Value & Cells(J, 12).Value & Cells(J, 13).Value & Cells(J, 14).Value & Cells(J, 15).Value & Cells(J, 16).Value & Cells(J, 17).Value & Cells(J, 18).Value & Cells(J, 19).Value & Cells(J, 20).Value & Cells(J, 21).Value & Cells(J, 22).Value & Cells(J, 23).Value & Cells(J, 24).Value & Cells(J, 25).Value & Cells(J, 26).Value & Cells(J, 27).Value & Cells(J, 28).Value & Cells(J, 29).Value & Cells(J, 30).Value & Cells(J, 31).Value & Cells(J, 32).Value & Cells(J, 33).Value & Cells(J, 34).Value & Cells(J, 35).Value & Cells(J, 36).Value & Cells(J, 37).Value
Next J
Columns("AL").AutoFit

Last = Nouveau.Worksheets("global").Cells(65536, 2).End(xlUp).Row 'Récupération de la dernière ligne non vide du nouveau fichier et stockage dans le variable Last
For J = 5 To Last
    'Concaténation de toutes les colonnes, lignes par lignes.
    Cells(J, 38).Value = Cells(J, 2).Value & Cells(J, 3).Value & Cells(J, 4).Value & Cells(J, 5).Value & Cells(J, 6).Value & Cells(J, 7).Value & Cells(J, 8).Value & Cells(J, 9).Value & Cells(J, 10).Value & Cells(J, 11).Value & Cells(J, 12).Value & Cells(J, 13).Value & Cells(J, 14).Value & Cells(J, 15).Value & Cells(J, 16).Value & Cells(J, 17).Value & Cells(J, 18).Value & Cells(J, 19).Value & Cells(J, 20).Value & Cells(J, 21).Value & Cells(J, 22).Value & Cells(J, 23).Value & Cells(J, 24).Value & Cells(J, 25).Value & Cells(J, 26).Value & Cells(J, 27).Value & Cells(J, 28).Value & Cells(J, 29).Value & Cells(J, 30).Value & Cells(J, 31).Value & Cells(J, 32).Value & Cells(J, 33).Value & Cells(J, 34).Value & Cells(J, 35).Value & Cells(J, 36).Value & Cells(J, 37).Value
Next J
Columns("AL").AutoFit

If Last > Last2 Then 'Determination de la taille necessaire du tableau
    Dernier = Last
Else
    Dernier = Last2
End If

'Intialisation d'un tableau de la taille du nombres maximum de lignes (Possibilité de 5000 lignes max)
Dim NomTableau(5000) As Integer
'For K = 0 To Dernier
'    NomTableau(K) = 0
'Next K

'Suppression de possible coloriage de cellule précédemment fait (utile par exemple lors d'une erreur de fichier à comparer, ou s'il on veut comparer avec un autre fichier.
For i = 5 To Last
    Nouveau.Worksheets("global").Range("" & i & ":" & i).Interior.ColorIndex = xlAutomatic
Next i


For i = 5 To Last
    Valeur_Test = Nouveau.Worksheets("global").Cells(i, 38).Value 'La valeur qu'on souhaite tester (test sur la valeur précédemment concaténée)
    For numLigne = 5 To Last2 'Boucle for déroulant les cellules concaténées de l'autre fichier.
'On verifie si la valeur Valeur_Test du nouveau fichier est contenue dans l'ancien
        If Ancien.Worksheets("global").Cells(numLigne, 38).Value = Valeur_Test Then
            NomTableau(i) = 0 'Si la valeur est trouvée, on met la ligne du tableau a 0...
            Exit For '...et on arrête la boucle.
        Else
            v = Nouveau.Worksheets("global").Cells(i, 4).Value 'Test sur une colonne a champ unique, pour voir si la ligne existe quand même.
            For numLigne2 = 5 To Last2
                If Ancien.Worksheets("global").Cells(numLigne2, 4).Value = v Then
                    NomTableau(i) = numLigne2   'Si trouvé, on insère le numéro de ligne dans le tableau.
                    Exit For
                Else
                    NomTableau(i) = -1 'Si le code article n'a pas été trouvé, on associe la case a -1 pour traitement plus tard.
                    'Nouveau.Worksheets("global").Range("" & i & ":" & i).Select 'On selectionne les lignes n'étant pas du tout présente dans l'ancien fichier...
                    'Selection.Interior.ColorIndex = 6 '...et on leur associe la couleur jaune.
                End If
            Next numLigne2
        End If
    Next numLigne
Next i




For J = 5 To Dernier 'On déroule le tableau pour récupérer tous les numéros de lignes enregistrés
If NomTableau(J) <> -1 Then
    If NomTableau(J) <> 0 Then 'Si le tableau n'est pas égal à 0 à la case j...
        For c = 2 To 37 '... on parcourt toutes les colonnes pour repérer en quelle(s) cellule(s) il y a différence.
            Valeur = Nouveau.Worksheets("global").Cells(J, c).Value
            'For Each cel In Range("" & NomTableau(J) & ":" & NomTableau(J))
                Valeur2 = Ancien.Worksheets("global").Cells(NomTableau(J), c).Value
                If Valeur <> Valeur2 Then 'Si
                    Nouveau.Worksheets("global").Cells(J, c).Interior.ColorIndex = 6 '...on associe la couleur jaune a la cellule
                End If
                Valeur = "" 'On reinitialise les variables
                Valeur2 = ""
        Next c
    End If
Else 'Si case -1, c'est que la ligne est nouvelle, donc a mettre entierement en jaune.
     'On selectionne les lignes n'étant pas du tout présente dans l'ancien fichier...
    Nouveau.Worksheets("global").Range("" & J & ":" & J).Interior.ColorIndex = 6 '...et on leur associe la couleur jaune.
End If
Next J




''Même procédure pour le second onglet.
'Ancien.Worksheets("Par code vrac").Activate
'Last3 = Cells(65536, 2).End(xlUp).Row
'For J = 5 To Last2
'    Cells(J, 39).Value = Cells(J, 8).Value & Cells(J, 9).Value & Cells(J, 10).Value & Cells(J, 11).Value & Cells(J, 12).Value & Cells(J, 13).Value & Cells(J, 14).Value & Cells(J, 15).Value & Cells(J, 16).Value & Cells(J, 17).Value & Cells(J, 18).Value & Cells(J, 19).Value & Cells(J, 20).Value & Cells(J, 21).Value & Cells(J, 22).Value & Cells(J, 23).Value & Cells(J, 24).Value & Cells(J, 25).Value & Cells(J, 26).Value & Cells(J, 27).Value & Cells(J, 28).Value & Cells(J, 29).Value & Cells(J, 30).Value & Cells(J, 31).Value & Cells(J, 32).Value & Cells(J, 33).Value & Cells(J, 34).Value & Cells(J, 35).Value & Cells(J, 36).Value & Cells(J, 37).Value & Cells(J, 38).Value
'Next J
'Columns("AM").AutoFit
'
'Nouveau.Worksheets("Par code vrac").Activate
'Last4 = Cells(65536, 2).End(xlUp).Row
'For J = 5 To Last
'    Cells(J, 39).Value = Cells(J, 8).Value & Cells(J, 9).Value & Cells(J, 10).Value & Cells(J, 11).Value & Cells(J, 12).Value & Cells(J, 13).Value & Cells(J, 14).Value & Cells(J, 15).Value & Cells(J, 16).Value & Cells(J, 17).Value & Cells(J, 18).Value & Cells(J, 19).Value & Cells(J, 20).Value & Cells(J, 21).Value & Cells(J, 22).Value & Cells(J, 23).Value & Cells(J, 24).Value & Cells(J, 25).Value & Cells(J, 26).Value & Cells(J, 27).Value & Cells(J, 28).Value & Cells(J, 29).Value & Cells(J, 30).Value & Cells(J, 31).Value & Cells(J, 32).Value & Cells(J, 33).Value & Cells(J, 34).Value & Cells(J, 35).Value & Cells(J, 36).Value & Cells(J, 37).Value & Cells(J, 38).Value
'Next J
'Columns("AM").AutoFit

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Thibault

PS : Je lance avec ces changements, en croisant les doigts. (merci encore :eek:)
 

Pièces jointes

  • rapport trimest AREG 20120727_v2TEST.xlsm
    37.6 KB · Affichages: 123
  • rapport trimest AREG 20120702TEST.xlsm
    30.4 KB · Affichages: 107

Thibault LB

XLDnaute Junior
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Ca ne marche toujours pas... Je l'ai laissé tourner 2h30, et rien ne se passe.

Lorsque j'annule la macro, le debogage me surligne le "Else" de ce bloc du script :

Code:
For i = 5 To Last
    Valeur_Test = Nouveau.Worksheets("global").Cells(i, 38).Value 'La valeur qu'on souhaite tester (test sur la valeur précédemment concaténée)
    For numLigne = 5 To Last2 'Boucle for déroulant les cellules concaténées de l'autre fichier.
'On verifie si la valeur Valeur_Test du nouveau fichier est contenue dans l'ancien
        If Ancien.Worksheets("global").Cells(numLigne, 38).Value = Valeur_Test Then
            NomTableau(i) = 0 'Si la valeur est trouvée, on met la ligne du tableau a 0...
            Exit For '...et on arrête la boucle.
        Else
            v = Nouveau.Worksheets("global").Cells(i, 4).Value 'Test sur une colonne a champ unique, pour voir si la ligne existe quand même.
            For numLigne2 = 5 To Last2
                If Ancien.Worksheets("global").Cells(numLigne2, 4).Value = v Then
                    NomTableau(i) = numLigne2   'Si trouvé, on insère le numéro de ligne dans le tableau.
                    Exit For
                [COLOR="#FFFF00"]Else[/COLOR]   
                 NomTableau(i) = -1 'Si le code article n'a pas été trouvé, on associe la case a -1 pour traitement plus tard.
                    'Nouveau.Worksheets("global").Range("" & i & ":" & i).Select 'On selectionne les lignes n'étant pas du tout présente dans l'ancien fichier...
                    'Selection.Interior.ColorIndex = 6 '...et on leur associe la couleur jaune.
                End If
            Next numLigne2
        End If
    Next numLigne
Next i
 

Dranreb

XLDnaute Barbatruc
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Je vois que la référence (colonne E) est unique dans les 2 fichiers. Ne pourriez vous chercher cette référence dans l'autre fichier avec WorksheetFunction.Match, et, si trouvé, vérifier que toutes les autre colonnes sont pareil des deux cotés ? Et arrêtez une bonne fois pour toutes de concaténer ces cellule: ça prend un temps fou inutilement.
Cordialement.
 

Thibault LB

XLDnaute Junior
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Effectivement, la colonne E est un code unique pour chaque ligne.
Mais ce que je pense être mieux, et ce que je fais dans ma macro, c'est :
1) Dans un premier temps, trouvé les lignes qui possède une différence (résultat direct avec la concaténation)
2) Une fois qu'on a les lignes avec des différences, il suffit de vérifier chaque cellule seulement de ces lignes la (et donc pas des 3700 lignes). Je me suis dit que ça diminuerai le temps de traitement
3) Entre ces deux étapes, je fais aussi mes tests sur cette fameuse colonne E, pour voir si la ligne serait pas nouvelle (dans ce cas la toute la ligne est en couleur)

Avec ta méthode, la plupart du temps, la référence sera trouvé, et donc il effectuera le test sur chaque colonne pour presque chaque ligne. Ca me semble plutôt être un retour en arrière. Non?
Après peut-être que j'ai un mauvais raisonnement, dans ce cas la je m'excuse :).

Thibault
 

Thibault LB

XLDnaute Junior
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Bon je vais essayer ta méthode, qui ne tente rien n'a rien !

Merci beaucoup a vous tous, encore une fois, je suis impressionné de toujours trouvé des gens ravie de m'aider, c'est un plaisir.

Je vous ferais un retour d'ici demain midi ! En attendant, si d'autres idées lumineuses vous viennent, n'hesitez pas.

Cordialement,
Thibault
 

Dranreb

XLDnaute Barbatruc
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Avec ta méthode, la plupart du temps, la référence sera trouvé, et donc il effectuera le test sur chaque colonne pour presque chaque ligne.
????
Quand je disais
vérifier que toutes les autre colonnes sont pareil des deux cotés ?
Je ne pensais pas à des colonnes entières évidemment mais les colonnes de la seule ligne en correspondance sur la référence à vérifier des deux cotés !
 

Thibault LB

XLDnaute Junior
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Bonjour,

Désolé de ne pas avoir été clair.
Sur les 3700 lignes, peut-être qu'a peine 100 lignes vont être insérés/modifiés entre les deux versions.
Du coup, la référence sera trouvé pour - disons dans mon exemple des 100 lignes changés - 3600 lignes dans l'autre fichier. Ce qui voudrait dire que pour ces 3600 lignes trouvées, les colonnes seront vérifiés par la macro (3600lignes*37colonnes=plus de 100 000 cellules a comparer avec l'autre fichier). Je trouve ça bien plus lourd que ma méthode.

En tout cas, je teste quand même ta méthode, j'ai peut-être tord :).

Cordialement,
 

Dranreb

XLDnaute Barbatruc
Re : [Besoin de méthode d'optimisation de temps de traitement, macro VBA]

Bonjour.
C'est sûr qu'il y aurait intérêt à charger les values de Range en tableaux et comparer ceux ci plutôt que les cellules pour limiter les requêtes à Excel
À +
 

Discussions similaires