Discussion :

[apprenant16]

Bonjour à tous,

J'ai un tableau avec près de 13 mille ligne.

J'exécute cette requête pour identifier les données qui remplissent les deux conditions et les colorier en rouge.

Mon souci c'est que la boucle tourne et affiche en mode pas à pas de bons résultats, mais si je l'exécute sur tout le tableau, elle tourne depuis presque deux heures de temps sans finir.

Avez-vous des idées pour améliorer le code

Merci bien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Doublons()
'
' Doublons Macro
'
 
'
Dim i As Long
Dim j As Long
 
For i = 2 To Range("AC" & Rows.Count).End(xlUp).Row
 
For j = 2 To Range("AC" & Rows.Count).End(xlUp).Row
 
If Range("AC" & j) = Range("AC" & i) And Range("AH" & j) = -Range("AH" & i) Then
 
    Range("AC" & i).Interior.ColorIndex = 3
    Range("AH" & i).Interior.ColorIndex = 3
    Range("AC" & j).Interior.ColorIndex = 3
    Range("AH" & j).Interior.ColorIndex = 3
 
'Rows(i).EntireRow.Delete
'Rows(j).EntireRow.Delete
End If
 
Next j
 
 
Next i
 
 
End Sub

[Franc]

Salut, teste ceci, j'utilise des tableaux en mémoire, c'est plus rapide que de manipuler les cellules.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub Doublons()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Feuil1")    ' Remplacer "Feuil1" par le nom de votre feuille
 
    Dim lastRow As Long
    lastRow = ws.Range("AC" & ws.Rows.Count).End(xlUp).Row
 
    ' Lire les colonnes AC et AH dans des tableaux
    Dim dataAC As Variant
    Dim dataAH As Variant
    dataAC = ws.Range("AC2:AC" & lastRow).Value
    dataAH = ws.Range("AH2:AH" & lastRow).Value
 
    ' Créer un tableau pour stocker les couleurs
    Dim colorsAC As Variant
    Dim colorsAH As Variant
    ReDim colorsAC(1 To UBound(dataAC, 1), 1 To 1)
    ReDim colorsAH(1 To UBound(dataAH, 1), 1 To 1)
 
    ' Utiliser un dictionnaire pour stocker les valeurs et leurs indices
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
 
    Dim i As Long
    For i = 1 To UBound(dataAC, 1)
        Dim key As String
        key = dataAC(i, 1) & "|" & dataAH(i, 1)
 
        If dict.exists(key) Then
            Dim pair As Variant
            pair = dict(key)
            colorsAC(i, 1) = 3    ' Colorier en rouge
            colorsAH(i, 1) = 3
            colorsAC(pair(1), 1) = 3
            colorsAH(pair(1), 1) = 3
        Else
            dict.Add key, Array(dataAC(i, 1), i)
        End If
    Next i
 
    Application.ScreenUpdating = False
 
     ' Appliquer les couleurs aux cellules de la feuille
    For i = 1 To UBound(dataAC, 1)
        If colorsAC(i, 1) = 3 Then
            ws.Range("AC" & i + 1).Interior.ColorIndex = 3
            ws.Range("AH" & i + 1).Interior.ColorIndex = 3
        End If
    Next i
End Sub

[apprenant16]

Bonjour Franc,

Je vous remercie pour la réponse claire et très efficace.

Cela fonctionne et c'est presque instantané.