macro doublons

[bpol]

Bonjour le forum,

Comment puis je faire pour que dans la feuil1 B1 se mette en rouge lorsqu'on introduit un doublons dans la feuil2 Col K.

Merci
BPOL

 

[Guest]

Re : macro doublons

Bonjour,

Dans le module de code de Feuil2:

Test uniquement la nouvelle saisie.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 11 Then
        Feuil1.Range("B1").Interior.ColorIndex = 3 * (Application.CountIf([k:K], Target) > 1) * -1
    End If
End Sub

A+

 

[bpol]

Re : macro doublons

Bonjour Hasco,
merci pour ta réponse
mais avant de faire des C.....
dans la feuille désirée j'ai déjà ce code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range

If Not Intersect(Target, Range("B1")) Is Nothing Then
    With Range("A3:R2500")
    Set c = .Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
        ActiveWindow.ScrollRow = c.Row - 0
        
        End If
    End With
 End If
End Sub

comment l'incorporer dedans ?
Bpol

 

[Guest]

Re : macro doublons

Re,
Vois si cela convient:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 
If Not Intersect(Target, Range("B1")) Is Nothing Then
    With Range("A3:R2500")
    Set c = .Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
        ActiveWindow.ScrollRow = c.Row - 0
 
        End If
    End With
 End If
 'Si une valeur de la colonne K a changé
 [COLOR=red][B]If Target.Column = 11 Then[/B][/COLOR]
[B][COLOR=red]    Feuil1.Range("B1").Interior.ColorIndex = 3 * (Application.CountIf([k:K], Target) > 1) * -1[/COLOR][/B]
[B][COLOR=red] End If[/COLOR][/B]
 
End Sub

A bientôt

 

[Paritec]

Re : macro doublons

Bonjour Hasco Bpol le forum
moi j'avais fait cela
alors je l'envoi
a+
papou

 

[bpol]

Re : macro doublons

​

RE,

Merci Hasco
mais là
je vais abusé mais comment faire pour que lorsque le doublons est supprimé les cases E1 redevienne blanche?

et pourquoi la deuxième condition ne fonctionne pas?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 
If Not Intersect(Target, Range("B1")) Is Nothing Then
    With Range("A3:R2500")
    Set c = .Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
        ActiveWindow.ScrollRow = c.Row - 0
 
        End If
    End With
 End If
 'Si une valeur de la colonne K a changé
 If Target.Column = 11 Then
    Sheets("fiche").Range("E1").Interior.ColorIndex = 3 * (Application.CountIf([k:K], Target) > 1) * -1
 End If
   [B] If Target.Column = 7 Then
    Sheets("fiche").Range("F1").Interior.ColorIndex = 18 * (Application.CountIf([k:K], Target) > 1) * -1[/B]
 End If
 
End Sub

encore Merci pour tout vos conseils
Bpol

 

[Paritec]

Re : macro doublons

Bonjour Bpol le forum,
ce qui prouve que tu ne lis même pas les réponses que je te fais.
Dans le fichier que je t'ai envoyé c'est le cas lorsque le doublon est retiré la cellule B2 redevient blanche. Post N° 5
Enfin je ne répondrai plus à tes posts comme cela je ne serai plus déçu par ta manière de faire
bonne soirée
Papou 😡

 

[bpol]

Re : macro doublons

Bonsoir Paritec,
mille excuses mais j'ai bien ouvert ton fichier mais je n'avais pas vu ta correction
sinon c'est extra cela grand merci

et je fais mon méa culpa (je surveillais plusieurs posts) et je suis un grand distrait, ne m'en tiens pas rigueur 🙁

peux tu m'aider une dernière fois

comment faire la syntaxe de la ligne en gras vu qu'il y a un end with

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 
If Not Intersect(Target, Range("B1")) Is Nothing Then
    With Range("A3:R2500")
    Set c = .Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
        ActiveWindow.ScrollRow = c.Row - 0
 
        End If
    End With
 
 If Sheets("fiche").Cells(1, 5).Interior.ColorIndex = 0 Then
    Dim fin, x, i As Long
    [B]fin = sheets("BD")..Range("K65000").End(xlUp).Row[/B]    
     For i = 3 To fin
        x = i
        y = x + 1
        For x = y To fin
   If Cells(i, 11) = Cells(x, 11) Then Sheets("fiche").Cells(1, 5).Interior.ColorIndex = 3
        Next
    Next
    End If
    End With

   If Sheets("fiche").Cells(1, 6).Interior.ColorIndex = 0 Then
    Dim fin, x, i As Long
   [B] fin = sheets("BD")..Range("K65000").End(xlUp).Row[/B]
    For i = 3 To fin
        x = i
        y = x + 1
        For x = y To fin
   If Cells(i, 11) = Cells(x, 11) Then Sheets("fiche").Cells(1, 6).Interior.ColorIndex = 18
        Next
    Next
 
 End If


End Sub

Bpol

 

[Paritec]

Re : macro doublons

Bonsoir Bpol,
et moi si tu veux avec ma macro, tu modifies ta procédure comme ci dessous.
Je n'ai pas fait de modif c'était ma première réponse et elle était déjà complète.
a+
Papou

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 
If Not Intersect(Target, Range("B1")) Is Nothing Then
    With Range("A3:R2500")
    Set c = .Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
        ActiveWindow.ScrollRow = c.Row - 0
 
        End If
    End With
 End If
 'Si une valeur de la colonne K a changé
 If Target.Column = 11 Then
    Sheets("fiche").Range("E1").Interior.ColorIndex = 3 * (Application.CountIf([k:K], Target) > 1) * -1
 End If
   [SIZE=4][COLOR=Red]Call Doubl[/COLOR][/SIZE] 
End Sub

 

[bpol]

Re : macro doublons

re paritec,
Grand Merci à toi

que ferais t on sans vous les pros !!

vu que cela été laborieux voici le fichier complet cela peut intéresser quelqu'un d'autre

http://cjoint.com/?bkuVniuvOv

Bpol