Adaptation du code

**pilounet54** · 11/03/2015, 11h19

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

 ligne = rows

mais pour l'instant cela bug de partout

merci

**Aposto** · 11/03/2015, 12h20

Bonjour a tous,

pour commencer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Option Explicite

il n'y a pas de e

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Option Explicit

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.EnableEvents=True

au début de la sub et

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**pilounet54** · 11/03/2015, 15h30

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Aposto** · 12/03/2015, 08h22

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

**pilounet54** · 12/03/2015, 08h42

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ligne = rows

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.EnableEvents = True

tu le mets au début ou à la fin et comment tu le mets
cordialement

**Aposto** · 12/03/2015, 08h49

en fait ta ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Target.Rows = ligne Then

devrait s'écrire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Target.Row = ligne Then

la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.EnableEvents = True

se met imméditement après le début de la Sub, comme tu l'as mis, c'est corect.

**pilounet54** · 12/03/2015, 12h33

j'ai répondu trop vide message d'erreur d’exécution 13 incompatibilité de type
à la ligne suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Aposto** · 13/03/2015, 09h29

Bonjour à tous,

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

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

**Gado2600** · 13/03/2015, 10h33

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Docmarti** · 13/03/2015, 11h17

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**pilounet54** · 13/03/2015, 17h26

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**pilounet54** · 13/03/2015, 17h34

stp tu le mets ou ton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

lookin:=xlValues

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

**pilounet54** · 14/03/2015, 07h20

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Theze** · 14/03/2015, 07h46

Bonjour,

Ce type d'instruction ne sert strictement à rien :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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é.

**Theze** · 14/03/2015, 07h53

Oups,

Un petit oubli dans la ligne

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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é.

**pilounet54** · 14/03/2015, 08h45

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Philippe Tulliez** · 14/03/2015, 09h31

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.

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

**pilounet54** · 14/03/2015, 11h52

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

**Docmarti** · 14/03/2015, 15h02

Bien sûr que c'est possible.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**pilounet54** · 14/03/2015, 16h26

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

Adaptation du code [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager