Adaptation du code

Version imprimable

Adaptation du code

bonjour je souhaite ceci mais que pour des lignes à partir de la ligne 3 mais qui irai de colonne A à E voici le code qui fonctionne pour colonnes "j’espère que c'est assez clair "

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Option Explicite
 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim Colonne As Integer
    Dim Adresse As String
 
    'On sort si plus d'une cellule a été modifiée
    If Target.Count > 1 Then Exit Sub
    'On sort si la cellule modifiée est vide
    If Target.Value = "" Then Exit Sub
 
    'Définit la colonne à vérifier (1=Colonne A, 2=colonne B ...etc...)
    Colonne = 1
 
    'Vérifie si c'est la colonne cible a été modifiée
    If Target.Column = Colonne Then
 
        'Recherche si la nouvelle donnée existe déjà dans la colonne.
        Adresse = Columns(Colonne).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _
            SearchDirection:=xlNext).Address
 
        'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
        'signifie qu'il y a un doublon dans la colonne.
        If Adresse <> Target.Address Then
 
            MsgBox "La donnée '" & Target & "' existe déjà dans la cellule " & Adresse
            'Suppression de la donnée
            Target.Value = ""
            Target.Select
 
        End If
    End If
 
End Sub

j'ai bien essayé j'ai fais

Code:

ligne = rows

mais pour l'instant cela bug de partout

merci

11/03/2015, 12h20
Aposto
Bonjour a tous,

pour commencer

Code:

Option Explicite

il n'y a pas de e

Code:

Option Explicit

ensuite il suffit de modifier la range sur laquelle tu appliques ton find:
Code:

1 2 Adresse = Range("A3:E" & ActiveSheet.UsedRange.Rows.Count).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _ SearchDirection:=xlNext).Address
je pense que des petites sécuritées supplémentaires seraient les bienvenues:

Code:

Application.EnableEvents=True

au début de la sub et

Code:

Application.EnableEvents=false

à la fin de manière à ne pas rappeler la macro lorsque celle-ci modifie une valeur dans la feuille.

Et vérifier que le find à renvoyé quelque chose avant d'appliquer la méthode address, sinon cela va lever une erreur

si tu as d'autres questions

pardon de mon ignorance mais cela ne fonctionne pas voici le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
''''''''''''''''''''''''''''''''''''''''''''''''''''''controle des doublons
Application.EnableEvents = False
 
    Dim ligne As Integer
 
    Dim Adresse As String
 
    'On sort si plus d'une cellule a été modifiée
    If Target.Count > 1 Then Exit Sub
    'On sort si la cellule modifiée est vide
    If Target.Value = "" Then Exit Sub
 
 
    'Vérifie si c'est la ligne cible a été modifiée
    If Target.Rows = ligne Then
 
        'Recherche si la nouvelle donnée existe déjà dans la ligne.
      Adresse = Range("A3:E" & ActiveSheet.UsedRange.Rows.Count).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _
            SearchDirection:=xlNext).Address
 
        'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
        'signifie qu'il y a un doublon dans la ligne.
        If Adresse <> Target.Address Then
 
            MsgBox "La donnée '" & Target & "' existe déjà dans la cellule " & Adresse
            'Suppression de la donnée
            Target.Value = ""
            Target.Select
 
        End If
    End If
 Application.EnableEvents = True
End Sub

12/03/2015, 08h22
Aposto
Bonjour à tous,

peut-tu me dire de quel genre de disfonctionement il s'agit:
- Erreur qui bloque l'execution, dans ce cas clique sur débogage et donnes moi la ligne sur laquelle le programme s'est arreté (surlignée en jaune)
- l'execution va jusqu'au bout mais le resultat n'est pas celui attendu. Dans ce cas il faudrait détailler le résultat obtenu
cela ne fonctionne pas n'est pas suffisamment précis:weird:
12/03/2015, 08h42
pilounet54

j'ai le message d'erreur quand j'ajoute comme il se doit je pense

Code:

ligne = rows

erreur d 'exécution 7 mémoire insuffisante ?
une question le

Code:

Application.EnableEvents = True

tu le mets au début ou à la fin et comment tu le mets
cordialement
12/03/2015, 08h49
Aposto

en fait ta ligne

Code:

If Target.Rows = ligne Then

devrait s'écrire

Code:

If Target.Row = ligne Then

la ligne

Code:

Application.EnableEvents = True

se met imméditement après le début de la Sub, comme tu l'as mis, c'est corect.
12/03/2015, 12h33
pilounet54
j'ai répondu trop vide message d'erreur d’exécution 13 incompatibilité de type
à la ligne suivant
Code:

1 2 Adresse = Range("A3:E" & ActiveSheet.UsedRange.Rows.Count).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _ SearchDirection:=xlNext).Address
qu'es qui peu clocher ?

Code:

Target.Offset(1, 0)

c'est bien ligne ,colonne es ce que dans mon cas il faudrait pas autre chose ou c'est bon

cordialement
13/03/2015, 09h29
Aposto

Bonjour à tous,

je viens de faire un test chez moi et cela fonctionne sans erreur

Peut-être faudrait-il essayer avec l'argument

Code:

lookin:=xlValues

dans la fonction find (voir aide si besoin, F1 sur le mot find)

Sinon envoie moi un classeur exemple pour que je vois un peu les valeurs du tableau.

Bonjour,

Je définirais bien une variable de type range pour la recherche. Parce qu'à mon avis, s'il ne trouve pas la valeur cherchée dans la plage de données, il n'a aucune cellule (du nothing) donc, l'adresse d'une range nothing renvoie une erreur en général.
Utilises ceci :
Code:

1 2 3 4 5 6 7 8 9 dim rng as range set rng = nothing set rng = Range("A3:E" & ActiveSheet.UsedRange.Rows.Count).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _ SearchDirection:=xlNext) if rng = nothing then adresse = "" else adresse = rng.Address end if

13/03/2015, 11h17
Docmarti
Bonjour.

Il y a une erreur dans After:=Target.Offset(1, 0).

Il faut mettre After:=Target.Offset(0, 0) ou encore After:=Target.
Code:

1 2 Adresse = Columns(Colonne).Find(What:=Target.Value, After:=Target, LookAt:=xlWhole, _ SearchDirection:=xlNext).Address

pas bien marche ?

bonjour
malgrès toutes les pistes j'en suis toujours au même point
voici le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
 
    Application.EnableEvents = False
    Dim ligne As Integer
    Dim Adresse As String
 
    'On sort si plus d'une cellule a été modifiée
    If Target.Count > 1 Then Exit Sub
    'On sort si la cellule modifiée est vide
    If Target.Value = "" Then Exit Sub
 
    'Définit la ligne à vérifier
   ligne = Target.Row
 
    'Vérifie si c'est la ligne cible a été modifiée
    If Target.Row = ligne Then
 
        'Recherche si la nouvelle donnée existe déjà dans la ligne .
        Adresse = Range("A3:E" & ActiveSheet.UsedRange.Rows.Count).Find(What:=Target.Value, After:=Target, LookAt:=xlWhole, _
            SearchDirection:=xlNext).Address
        'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
        'signifie qu'il y a un doublon dans la ligne.
        If Adresse <> Target.Address Then
 
            MsgBox "La donnée '" & Target & "' existe déjà dans la cellule " & Adresse
            'Suppression de la donnée
            Target.Value = ""
            Target.Select
 
        End If
    End If
 Application.EnableEvents = True
End Sub

si vous souhaiter modifier le code redonner moi un ensemble svp c'est mieux pour le vieux que je suis
cordialement

13/03/2015, 17h34
pilounet54

stp tu le mets ou ton

Code:

lookin:=xlValues

dans son ensemble qu'es que cela donne ! puisque cela fonctionne chez toi
merci d'avance

Citation:

Envoyé par Aposto

Bonjour à tous,

je viens de faire un test chez moi et cela fonctionne sans erreur

Peut-être faudrait-il essayer avec l'argument

Code:

lookin:=xlValues

dans la fonction find (voir aide si besoin, F1 sur le mot find)

Sinon envoie moi un classeur exemple pour que je vois un peu les valeurs du tableau.

Citation:
Envoyé par Gado2600
Bonjour,

Je définirais bien une variable de type range pour la recherche. Parce qu'à mon avis, s'il ne trouve pas la valeur cherchée dans la plage de données, il n'a aucune cellule (du nothing) donc, l'adresse d'une range nothing renvoie une erreur en général.
Utilises ceci :
Code:

1 2 3 4 5 6 7 8 9 dim rng as range set rng = nothing set rng = Range("A3:E" & ActiveSheet.UsedRange.Rows.Count).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _ SearchDirection:=xlNext) if rng = nothing then adresse = "" else adresse = rng.Address end if
merci pour le regard et tes instructions !
j'ai le message suivant erreur de compilation utilisation incorrecte de l'objet je pense que c'est le nothing l'erreur

Bonjour,

Ce type d'instruction ne sert strictement à rien :

Code:

1
2
3
4
5
 
    ligne = Target.Row
 
    'Vérifie si c'est la ligne cible a été modifiée
    If Target.Row = ligne Then

puisque d'office "Target.Row" sera forcement égal à "ligne" vu l'instruction qui précède "ligne = Target.Row".
La position de ce mets juste avant l'instruction qui va forcement déclencher la procédure donc :

Code:

1
2
3
4
5
6
 
Application.EnableEvents = False
 
Target.Value = ""
 
Application.EnableEvents = True

Voici un code qui devrait marcher (pas testé). Il ne faut jamais utiliser une propriété ou méthode avec la fonction Find car si pas trouvé, erreur d'office. Il faut utiliser une variable Objet (Range) et faire un contrôle d'initialisation (Nothing) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
 
    Dim Cel As Range
    Dim ligne As Long
    Dim Adresse As String
 
    'On sort si plus d'une cellule a été modifiée
    If Target.Count > 1 Then Exit Sub
    'On sort si la cellule modifiée est vide
    If Target.Value = "" Then Exit Sub
 
 
'    'Définit la ligne à vérifier
'    ligne = Target.Row
'
'    'Vérifie si c'est la ligne cible a été modifiée
'    If Target.Row = ligne Then
 
    'Recherche si la nouvelle donnée existe déjà dans la ligne .
    Set Cel = Range("A3:E" & ActiveSheet.UsedRange.Rows.Count).Find(Target.Value, Target, xlValues, xlWhole, , xlNext)
 
    'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
    'signifie qu'il y a un doublon dans la ligne.
    If Not Cel Is Nothing Then
 
        If Cel.Address <> Target.Address Then
 
            MsgBox "La donnée '" & Target.Value & "' existe déjà dans la cellule " & Cel.Address(0, 0)
 
            'Suppression de la donnée
            Application.EnableEvents = False
 
            Target.Value = ""
 
            Application.EnableEvents = True
 
            Target.Select
 
        End If
 
    End If
 
End Sub

Hervé.

Oups,

Un petit oubli dans la ligne

Citation:

La position de ce mets juste avant l'instruction qui va forcement déclencher la procédure

La position de "Application.EnableEvents = False" ce mets juste avant l'instruction qui va forcement déclencher la procédure et donc "Application.EnableEvents = True" juste après. Si tu le mets en début de code pour te simplifier la vie, tu risque de te retrouver avec les évènements bloqués car dans ce type d'instruction :
Code:

1 2 3 4 5 6 7 8 9 Application.EnableEvents = False Dim ligne As Integer Dim Adresse As String 'On sort si plus d'une cellule a été modifiée If Target.Count > 1 Then Exit Sub On sort si la cellule modifiée est vide If Target.Value = "" Then Exit Sub
si "If Target.Count > 1 Then Exit Sub" ou "If Target.Value = "" Then Exit Sub" sont à "True", sortie de procédure sans exécuter l'instruction "Application.EnableEvents = True"

Hervé.

14/03/2015, 08h45
pilounet54

Au secours !
bonjour tous
cela fonctionne pour une colonne ok
'Recherche si la nouvelle donnée existe déjà dans la colonne.
Code:

1 2 Adresse = Columns(Colonne).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _ SearchDirection:=xlNext).Address
ceci fonctionne pour une ligne ok
'Recherche si la nouvelle donnée existe déjà dans la ligne.
Code:

1 2 Adresse = Rows(ligne).Find(What:=Target.Value, After:=Target.Offset(0, 0), LookAt:=xlWhole, _ SearchDirection:=xlNext).Address
mais ceci ne fonctionne pas! pour une ligne qui n'irai de la colonne A à la colonne E qui serai représenter par le target.row dans la plage qui définirai la ligne à vérifier

je cherche je ne trouve pas ?
Code:

1 2 Adresse = Range("A3:E" & ActiveSheet.UsedRange.Rows.Count).Find(What:=Target.Value, After:=Target.Offset(0, 0), LookAt:=xlWhole, _ SearchDirection:=xlNext).Address
pourquoi d’après vous ?

cordialement
14/03/2015, 09h31
Philippe Tulliez

Bonjour,
J'ai beau parcourir l'ensemble des fils de cette discussion, à aucun moment tu n'expliques quelle est la finalité de ta procédure.
Est-ce vérifier que la valeur introduite est présente dans la colonne, sur la même ligne, sur une plage ?
La valeur cherchée doit-elle être complète ou partielle, la casse doit-elle être respectée ou pas, etc.

Citation:

bonjour je souhaite ceci mais que pour des lignes à partir de la ligne 3 mais qui irai de colonne A à E voici le code qui fonctionne pour colonnes "j’espère que c'est assez clair "

Ta demande initiale n'est pas du tout claire pour moi. "Je souhaite ceci" ???, mais encore
14/03/2015, 11h52
pilounet54

bonjour et merci !
Je cherche simplement dans une plage si je modifie ou je remets une valeur de la cellule de ma plage A3 :E cela contrôle dans les autres cellules la valeur de la même ligne dans plage A3 : E
Je ne contrôle pas du tout toute la ligne ou les autres lignes à ce moment là ,encore moins la colonne
La valeur cherchée est complète ex : si je mets 10 cela recherche que la valeur 10 dans les autres cellules et pas 2103
Je ne sais pas pour la casse ce que cela veut dire, mais comme c’est une option :

J’ai trouvé pour une ligne ainsi que pour une colonne et aussi pour toutes les lignes il me reste de comprendre ou à trouver pour restreinte qu’a une plage
Je sais que ce n’est pas facile de me comprendre et je m’en excuse humblement

j'ai bien essayer toutes les pistes qui m'on été donnée et à tous je les en remercie

mais peut être que ce n'est pas possible tout simplement

Cordialement

Bien sûr que c'est possible.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
 If Target.Count > 1 Then Exit Sub
 
    'Definir quelle feuille
    Set f = ActiveSheet
 
    'Definir quelle region de cette feuille
    Set tout = f.Range("B3:E" & f.Rows.Count)
 
    'Definir quelle ligne de cette region
    Set cetteligne = Intersect(tout, f.Rows(Target.Row))
 
    If cetteligne Is Nothing Then Exit Sub
 
    'Est-ce que Target est dans cetteligne
    If Intersect(cetteligne, Target) Is Nothing Then Exit Sub
 
 
    'Recherche sur cette ligne
 Methode = 1
 
    If Methode = 1 Then
        'Methode 1 : Rechercher doublon avec For...Next
        Set rng = Nothing
        For k = 1 To cetteligne.Columns.Count
 
            If cetteligne.Cells(1, k).Value = Target.Value Then
                If Intersect(cetteligne.Cells(1, k), Target) Is Nothing Then
                    Set rng = cetteligne.Cells(1, k)
                    Exit For
                End If
            End If
 
        Next
 
    Else
        'Methode 2 : Rechercher doublon avec FIND et LookIn:=xlFormulas
        Set rng = cetteligne.Find(what:=Target.Value, After:=Target, LookIn:=xlFormulas, LookAt:=xlWhole, _
        SearchFormat:=False, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
 
    End If
 
    If rng Is Nothing Then Exit Sub
 
    If rng.Address = Target.Address Then
        'Pas de doublon
    Else
 
        MsgBox "Doublon en " & rng.Address
    End If
 
End Sub

14/03/2015, 16h26
pilounet54

impeccable mieux du neuf ! en te remerciant très chaleureusement

si je pouvais te mettre 10 000 points dans tous les cas tu le mérite je te les donnerai
@+ à tous