Microsoft 365 Worksheet_Change(ByVal Target As Range)

[tienou42]

Bonjour,

Ca fonctionne mais c'est loin d'être parfait, par contre mon niveau est trop juste pour aller plus loin, petit problème : si je tape "3", ça me trouve un doublon sur la cellule qui contient "B3"

Pouvez vous m'aider ?

Code :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Valeur
Dim xCell As Range
If flagFlux = True Then Exit Sub
If Not Intersect(Range("B2:B33,E2:E33,H2:H33,K2:K33,N2:N33"), Target) Is Nothing Then
flagFlux = True
For Each xCell In Intersect(Range("B2:B33,E2:E33,H2:H33,K2:K33,N2:N33"), Target).Cells
If Application.CountIf(Range("B2:N33"), xCell) > 1 Then
     MsgBox "Doublon !!!! :" & xCell
     Valeur = Target
     Range("B2:B33,E2:E33,H2:H33,K2:K33,N2:N33").Find(Valeur).Activate
End If
Next xCell
End If
flagFlux = False
End Sub

ps : ceci ne focntionne pas : "If Application.CountIf(Range("B2:N33"), xCell) > 1 Then" en ça : "If Application.CountIf(Range("B2:B33,E2:E33,H2:H33,K2:K33,N2:N33"), xCell) > 1 Then"

 

[Jacky67]

Bonjour,

Ca fonctionne mais c'est loin d'être parfait, par contre mon niveau est trop juste pour aller plus loin, petit problème : si je tape "3", ça me trouve un doublon sur la cellule qui contient "B3"

Pouvez vous m'aider ?

Code :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Valeur
Dim xCell As Range
If flagFlux = True Then Exit Sub
If Not Intersect(Range("B2:B33,E2:E33,H2:H33,K2:K33,N2:N33"), Target) Is Nothing Then
flagFlux = True
For Each xCell In Intersect(Range("B2:B33,E2:E33,H2:H33,K2:K33,N2:N33"), Target).Cells
If Application.CountIf(Range("B2:N33"), xCell) > 1 Then
     MsgBox "Doublon !!!! :" & xCell
     Valeur = Target
     Range("B2:B33,E2:E33,H2:H33,K2:K33,N2:N33").Find(Valeur).Activate
End If
Next xCell
End If
flagFlux = False
End Sub

ps : ceci ne focntionne pas : "If Application.CountIf(Range("B2:N33"), xCell) > 1 Then" en ça : "If Application.CountIf(Range("B2:B33,E2:E33,H2:H33,K2:K33,N2:N33"), xCell) > 1 Then"

Bonjour,
S'il s'agit d'avoir un message s'il y a doublon
Essaye ceci

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim C As Range
    If Target.Count > 1 Then Exit Sub
    If Intersect(Range("B2:B33,E2:E33,H2:H33,K2:K33,N2:N33"), Target) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub
    For Each C In Range("B2:B33, E2:E33, H2:H33, K2:K33, N2:N33")
        If Target.Address <> C.Address And C = Target Then
            MsgBox "Doublon de: " & Target & vbLf & "En " & C.Address, vbInformation, "Information"
        End If
    Next
End Sub

 

[tienou42]

Ca m'a l'air nickel, merci Jacky67.
Plus qu'a mettre en production.