Effacer données si rien dans la cellule d'à coté

[sev]

Bonjour le forum,

J'ai un code pour repérer les doublons dans deux tableaux.

Je voudrais que si les valeures du 1er tableau en colonne K sont effacées que celle de J le soient aussi.

Function NbSiMZ(champrech As Range, valCherchée)
  Application.Volatile
  temp = 0
  For i = 1 To champrech.Areas.Count
    For j = 1 To champrech.Areas(i).Count
      If valCherchée = champrech.Areas(i)(j) Then
        temp = temp + 1
        
       
      End If
       
    Next j
  Next i
  NbSiMZ = temp
End Function

Sub macro777()
Sheets("OPTH").Unprotect
  For Each celluleTraitée In Range("D4:D18,K4:K18") 'repère les doublons
  If NbSiMZ(Range("D4:D18,K4:K18"), celluleTraitée.Value) > 1 And celluleTraitée.Value <> "" Then
 
   celluleTraitée.Font.ColorIndex = 3 'rouge
 Else
   
  If NbSiMZ(Range("D4:D18,K4:K18"), celluleTraitée.Value) = 1 And celluleTraitée.Value <> "" Then 'remet les polices en noir
  celluleTraitée.Font.ColorIndex = 1 'noir
    End If
    
    End If
    
Next

For Each celluleTraitée In Range("K4:K18") 'repère les doublons
  If celluleTraitée.Font.ColorIndex = 3 Then 'rouge
   celluleTraitée.Value = ""

'J'ai essayé cela sans succès
 [COLOR="Red"]If celluleTraitée.Value = "" Then
 celluleTraitée(Offset, -1) = ""[/COLOR]

 Else
 End If
 End If
 Next
 
 
End Sub

 

[GPLIONEL]

Re : Effacer données si rien dans la cellule d'à coté

Bonjour sev

et avec :
If celluleTraitée.Value = "" Then
celluleTraitée.Offset(0, -1) = ""

 

[sev]

Re : Effacer données si rien dans la cellule d'à coté

Un 1 mot MERCI

 

[Pierrot93]

Re : Effacer données si rien dans la cellule d'à coté

Bonjour Sev, Lionel

une autre solution permettant de traiter les 2 cellules en même temps :

If celluleTraitée.Font.ColorIndex = 3 Then
   celluleTraitée.Offset(0, -1).Resize(1, 2).Value = ""

bon après midi
@+