"Lighter" un code qui colore des cellules

Pineurne · 4 Novembre 2011

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é :

Code:

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é · 8 Novembre 2011

Re : "Lighter" un code qui colore des cellules

Bonjour le fil, le forum,

mapomme à dit:
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:

VB:

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 · 30 Novembre 2011

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

"Lighter" un code qui colore des cellules

Pineurne

XLDnaute Junior

Efgé

XLDnaute Barbatruc

Pineurne

XLDnaute Junior

Discussions similaires