chaelie2015
XLDnaute Accro
Bonjour Forum
ce code détecte si une cellule dans la colonne B (à partir de la ligne B3) est en double avec une autre cellule dans la même colonne. Si une redondance est détectée, un message d'erreur s'affiche indiquant la ligne où la redondance a été trouvée. De plus, la cellule existante avec la redondance est colorée en rouge. Ainsi, lorsque vous changez une cellule dans la colonne B pour qu'elle devienne une redondance, la cellule existante correspondante est mise en évidence en rouge.
Je souhaite compléter ce code de manière à restaurer la couleur d'origine de la cellule existante, qui avait été colorée en rouge, dès que je supprime la cellule redondante.
Merci
ce code détecte si une cellule dans la colonne B (à partir de la ligne B3) est en double avec une autre cellule dans la même colonne. Si une redondance est détectée, un message d'erreur s'affiche indiquant la ligne où la redondance a été trouvée. De plus, la cellule existante avec la redondance est colorée en rouge. Ainsi, lorsque vous changez une cellule dans la colonne B pour qu'elle devienne une redondance, la cellule existante correspondante est mise en évidence en rouge.
Je souhaite compléter ce code de manière à restaurer la couleur d'origine de la cellule existante, qui avait été colorée en rouge, dès que je supprime la cellule redondante.
Merci
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim cell As Range
Dim checkRange As Range
Dim duplicateCell As Range
Dim found As Boolean
Dim originalColor As Long
' Spécifiez la plage de vérification (à partir de B3)
Set checkRange = Me.Range("B3:B" & Me.Cells(Me.Rows.Count, "B").End(xlUp).Row)
Set duplicateCell = Nothing
found = False
' Si la cellule modifiée se trouve dans la plage de vérification
If Not Intersect(Target, checkRange) Is Nothing Then
For Each cell In checkRange
If cell.Value = Target.Value And cell.Address <> Target.Address Then
Set duplicateCell = cell
found = True
Exit For
End If
Next cell
If found Then
MsgBox "Cette donnée est déjà inscrite dans la colonne B à la ligne " & duplicateCell.Row & ".", vbExclamation, "Redondance détectée"
originalColor = duplicateCell.Interior.Color ' Mémoriser la couleur initiale
' Colorer la cellule existante en rouge
duplicateCell.Interior.Color = RGB(255, 0, 0)
End If
End If
End Sub
