"Lighter" un code qui colore des cellules

[Pineurne]

Bonjour à tous,

Voilà je suis assez ennuyé. J'ai créé une macro dont la fonction est la suivante : j'ai 2 onglets "Fichier1" et "Fichier2". Je veux comparer ces 2 onglets et faire ressortir lorsqu'il y a une différence. Pour ce faire, j'analyse ligne par ligne et s'il n'y a pas de différences, alors je coloris la case A des 2 onglets. Voici le code que j'ai utilisé :

While Sheets("Fichier1").Range("A" & i1).Value <> 0
        doc_fichier1_cree = True
        While Sheets("Fichier2").Range("A" & i2).Value <> 0
            If Sheets("Fichier1").Range("A" & i1).Value = Sheets("Fichier2").Range("A" & i2).Value And Sheets("Fichier1").Range("K" & i1).Value = Sheets("Fichier2").Range("K" & i2).Value And Sheets("Fichier1").Range("R" & i1).Value = Sheets("Fichier2").Range("R" & i2).Value And Sheets("Fichier1").Range("S" & i1).Value = Sheets("Fichier2").Range("S" & i2).Value And Sheets("Fichier1").Range("T" & i1).Value = Sheets("Fichier2").Range("T" & i2).Value Then
                doc_fichier1_cree = False
                Sheets("Fichier2").Select
                Range("A" & i2).Select
                With Selection.Interior
                    .ColorIndex = 6
                    .Pattern = xlSolid
                End With
            End If
            i2 = i2 + 1
        Wend
        If doc_fichier1_cree = False Then
            Sheets("Fichier1").Select
            Range("A" & i1).Select
            With Selection.Interior
                    .ColorIndex = 6
                    .Pattern = xlSolid
            End With
        End If
        i2 = 2
        i1 = i1 + 1
    Wend

Mon problème est que j'ai 5000 lignes dans mes 2 onglets et le temps de traitement s'avère donc extrêmement long ! Je précise que je ne suis pas un expert en programmation, mais j'aime bien bidouiller et me faire des petits outils. Avez-vous une idée de comment alléger le code ?

Merci d'avance !

 

[Efgé]

Re : "Lighter" un code qui colore des cellules

Bonjour le fil, le forum,

Je coince sur : F1.Range(ListeF1).Interior.ColorIndex = 6

Exact, il y a bien un problème.
Une autre version, testée sous 2003 avec 5 000 lignes par tableau:

Sub Test_Tab_4()
Dim F1 As Worksheet, F2 As Worksheet, I1&, I2&, TabF1(), TabF2(), Deb!, ListeF1 As Range, ListeF2 As Range
Deb = Timer
Application.ScreenUpdating = False
Set F1 = Sheets("Fichier1"): Set F2 = Sheets("Fichier2")
TabF1 = F1.UsedRange.Value
TabF2 = F2.UsedRange.Value
F1.Columns(1).Interior.ColorIndex = xlNone
F2.Columns(1).Interior.ColorIndex = xlNone
For I1 = LBound(TabF1, 1) + 1 To UBound(TabF1, 1)
    For I2 = LBound(TabF2, 1) + 1 To UBound(TabF2, 1)
            If TabF1(I1, 1) = TabF2(I2, 1) And _
                TabF1(I1, 11) = TabF2(I2, 11) And _
                TabF1(I1, 18) = TabF2(I2, 18) And _
                TabF1(I1, 19) = TabF2(I2, 19) And _
                TabF1(I1, 20) = TabF2(I2, 20) Then
                If Not ListeF1 Is Nothing Then
                    Set ListeF1 = Application.Union(ListeF1, F1.Range(F1.Cells(I1, 1).Address))
                Else
                    Set ListeF1 = F1.Range(F1.Cells(I1, 1).Address)
                End If
                If Not ListeF2 Is Nothing Then
                    Set ListeF2 = Application.Union(ListeF2, F2.Range(F2.Cells(I2, 1).Address))
                Else
                    Set ListeF2 = F2.Range(F2.Cells(I2, 1).Address)
                End If
                Exit For
            End If
    Next I2
Next I1
ListeF1.Interior.ColorIndex = 6
ListeF2.Interior.ColorIndex = 6
Application.ScreenUpdating = True
MsgBox Timer - Deb
End Sub

A noter qu'en cas de doublons dans les tableaux, il faut supprimer le "Exit For"
Cordialement

 

[Pineurne]

Re : "Lighter" un code qui colore des cellules

Bonjour,

Alors j'ai testé un peu tout ça, mais ça ne ralentit que très peu le code. La solution que j'ai trouvé : laisser tourner le PC la nuit lorsque j'ai besoin de faire ma comparaison Je sais, ce n'est pas très écolo mais finalement je ne le fais pas tellement souvent