Mise en forme conditionnelle problématique

Bonjour le forum

Voici mon souci.

J'ai une macro qui applique une couleur sur des cellules situées sur la même ligne que des doublons.

Du premier à l'avant dernier doublon la ligne devient orange, la ligne du dernier doublon est colorée en vert.

Voici le code:

Sub traitement()
Dim LastLig As Long

With Feuil1
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    With .Range("A3:K" & LastLig)
        .FormatConditions.Delete
        .FormatConditions.Add(Type:=xlExpression, Formula1:= _
        "=ET($B2=$B3;$B3<>$B4)").Interior.ColorIndex = 35
        .FormatConditions.Add(Type:=xlExpression, Formula1:= _
        "=OU(ET($B2<>$B3;$B3=$B4);ET($B2=$B3;$B3=$B4))").Interior.ColorIndex = 40
    End With
End With

End Sub

A la suite de ce traitement je veux effacer le contenu des cellules qui n'ont pas de couleur de la colonne K.

Voici le deuxième code:

Sub EffaceContenu()
Dim cell As Range
Set myRange = ActiveSheet.Range("K2:K300")
For Each cell In myRange
If cell.Interior.ColorIndex = 2 Then
    cell.ClearContents
    cell.Interior.ColorIndex = xlNone
Else
End If
Next
End Sub

Mon souci est que toutes les cellules de la colonne sont effacées.

Je me trompe peux-être mais je pense que les couleurs créées par la mise en forme conditionnelles sont "virtuelles".

En effet si je sélectionne une cellule colorée et que j'effectue un clic droit / format de cellule/ remplissage,

il n'y a aucune couleur!!!!!

Et donc ma macro N°2 ne voit pas de couleurs et efface toute la colonne.

Existe il un moyen d'appliquer réellement la couleur aux cellules concernées ?

Mes macros sont peux-être inadaptées ?

J'ai besoin de votre aide.

Merci

Bonjour

jp65 a écrit :

Je me trompe peux-être mais je pense que les couleurs créées par la mise en forme conditionnelles sont "virtuelles".

Non tu ne te trompes pas

Une solution (que je trouve compliqué - juste mon avis) est celle-ci https://forum.excel-pratique.com/cours-astuces/fonction-qui-retourne-la-couleur-active-d-une-mfc-t29247.html

Une autre solution que je propose est pour moi plus simple

Lors de la création de la MEFC par la macro, il faut rajouter les formules dans 2 colonnes (qui peuvent être masquées)

Ensuite ta 2ème macro parcourt ces colonnes et agit selon ce que tu souhaites

1ère macro : Ajout

Sub traitement()
Dim LastLig As Long

  With Feuil1
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    With .Range("A3:K" & LastLig)
      .FormatConditions.Delete
      .FormatConditions.Add(Type:=xlExpression, Formula1:= _
          "=ET($B2=$B3;$B3<>$B4)").Interior.ColorIndex = 35
      .FormatConditions.Add(Type:=xlExpression, Formula1:= _
          "=OU(ET($B2<>$B3;$B3=$B4);ET($B2=$B3;$B3=$B4))").Interior.ColorIndex = 40
    End With
    .Range("L3:L" & LastLig).Formula = "=AND($B2=$B3,$B3<>$B4)"
   .Range("M3:M" & LastLig).Formula = "=OR(AND($B2<>$B3,$B3=$B4),AND($B2=$B3,$B3=$B4))"
  End With
End Sub

2ème macro : Complétement différente

Sub EffaceContenu()
Dim Cell As Range, MyRange As Range

  Set MyRange = Range("L2:L" & Cells(Rows.Count, 1).End(xlUp).Row)
  For Each Cell In MyRange
    If Cell <> True And Cell.Offset(0, 1) <> True Then
      Cell.Offset(0, -1).ClearContents
      Cell.Offset(0, -1).Interior.ColorIndex = xlNone
    End If
  Next Cell
End Sub

A tester

Bonjour à tous

Banzai64 comme d'habitude tes solutions fonctionnent immédiatement.

Je te soumet un autre code qui en l'état n'est pas totalement fonctionnel mais dont le but est le même que mon premier post.

Le but initial de la macro est d'effacer les doublons. J'ai tenté de l'adapter pour coloriser les doublons.

La recherche s'effectue sur les 3 colonnes A B C .

Sub OrdreRespectéDictionary()
  Set MonDico = CreateObject("Scripting.Dictionary")
  'Application.ScreenUpdating = False
  i = 2
  Do While Cells(i, "A") <> ""
   If Not MonDico.Exists(Cells(i, "A") & Cells(i, "B") & Cells(i, "C")) Then
      MonDico(Cells(i, "A") & Cells(i, "B") & Cells(i, "C")) = ""
       i = i + 1
   Else
     Rows(i).Interior.ColorIndex = 40
     i = i + 1

   End If
Loop
End Sub

Meci encore

Re

Après fouillage sur le net j'ai fait évoluer la macro.

Cette fois toutes les lignes contenant les doublons sont colorées en orange sauf la ligne correspondante

au dernier doublon de la série.

Sub GardeDernier()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = [A65000].End(xlUp).Row
  Do While i > 2
    temp = Cells(i, "A") & Cells(i, "B")
    If Not MonDico.Exists(temp) Then
      MonDico(temp) = ""
      i = i - 1
    Else
      Rows(i).Interior.ColorIndex = 40 '40 = orange
      i = i - 1
   End If
  Loop
End Sub

Il me manque encore à colorer cette ligne du dernier doublon de la série.

A suivre

Bonjour

sans ton fichier

Préambule : Le tableau trié : Une clé sur la colonne A et l'autre sur la colonne B

A tester

Sub GardeDernier()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  i = [A65000].End(xlUp).Row
  Do While i > 2
    temp = Cells(i, "A") & Cells(i, "B")
    If Not MonDico.Exists(temp) Then
      MonDico(temp) = ""
      If temp = Cells(i - 1, "A") & Cells(i - 1, "B") Then
        Rows(i).Interior.ColorIndex = 34
      End If
      i = i - 1
    Else
      Rows(i).Interior.ColorIndex = 40 '40 = orange
     i = i - 1
   End If
  Loop
End Sub

Aie

C'est vrai que je n'ai pas joint de fichier. Je vais essayer de me faire pardonner par une pirouette.

"Banzai64 je ne joins pas de fichier car ton expertise transforme les mots que je jette en phrases compréhensibles. "

Ta dernière réponse va d'ailleurs dans le sens de la pommade que je viens de te passer car bien évidemment ta solution fonctionne.

Néanmoins pour aider ceux qui pourraient être intéressés par ce post, je joint un fichier exemple.

Banzai64 une fois de plus un grand merci pour ton aide.