Discussion :

[bbcancer]

Bonjour à tous

J'utilise une macro qui me trouve les doublons sur plusieurs feuilles excel. Cette macro marche très bien.
Par contre, j'ai un petit soucis. quand je corrige mon doublon (même si je relance la macro) la mise en forme que j'ai appliqué reste.
J'aimerai donc trouvé une macro qui me permettent une fois le doublon corrigé de disparaitre (enfin la mise en forme) et si le doublon n'a pas été corrigé que la mise en forme reste.

Merci

Cordialement

[casefayere]

Bonjour,

envoies ta macro, ça sera plus facile (enfin, peut-être !)

[bbcancer]

Ma macro que j'utilise est la suivante : (en fait c'est 2 macros)

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
Public Sub CDouble(RngA As Range, RngB As Range)
 'Recherche les doublons entre 2 plages
 
Dim c As Range, v As Range
 
For Each c In RngA
    If c.Value <> "" Then 
        Set v = RngB.Find(c.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not v Is Nothing Then 
            If c.Parent.Name & c.Address <> v.Parent.Name & v.Address Then 
            c.Interior.ColorIndex = 46 
            c.Font.Bold = True 
            c.Font.ColorIndex = 36 
            v.Interior.ColorIndex = 46 
            v.Font.Bold = True 
            v.Font.ColorIndex = 36 
            Set v = Nothing 
            End If
        End If
    End If
Next c
 
End Sub

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
Sub Appliquer_doublons()
 
Dim i As Byte, j As Byte
Dim LastLigA As Long, LastLigB As Long
Dim TF As Variant
 
Application.ScreenUpdating = False
 
TF = Array("Feuil1", "Feuil2", "Feuil3", "Feuil4") 
 
For i = LBound(TF) To UBound(TF)
    LastLigA = Sheets(TF(i)).Cells(Rows.Count, 1).End(xlUp).Row
        For j = i To UBound(TF)
            LastLigB = Sheets(TF(j)).Cells(Rows.Count, 1).End(xlUp).Row 
            CDouble Sheets(TF(i)).Range("B9:B" & LastLigA), Sheets(TF(j)).Range("B9:B" & LastLigB) 
            CDouble Sheets(TF(i)).Range("C9:C" & LastLigA), Sheets(TF(j)).Range("C9:C" & LastLigB) 
        Next j
Next i
 
End Sub

Voilà
J'espère que ca vous aidera

[bellande]

Bonjour,
A première vu, il faut ajouter des instructions d'effacement de format sinon les anciens formats persistent. Il faudrait tester un truc de ce style. C'est pas génial et je ne sais pas si il y a une partie des styles à garder malgré tout.
Ca fera peut-être avancer un peu la question.
a+

Code :

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

1
2
3
4
   If Not v Is Nothing Then
            v.ClearFormats
            c.ClearFormats
            If c.Parent.Name & c.Address <> v.Parent.Name & v.Address Then

[bbcancer]

J'ai essayé et cela ne marche pas...
Et en plus cela m'efface les bordures du tableau et toute la mise en forme