PROBLEME CODE - NEXT SANS FOR

Le 26/01/2015 à 21:38

Bonjour Messieurs, Mesdames,

Macro: but étant d'anticiper les doublons dans une liste de contact. Macro événementielle.

Fichier joint pour exemple.

Si j'insère un nom déjà présent dans la colonne "prénom" la macro doit l'identifier or problème de next sans for....

Je ne vois pas où j'ai pu oublier un for next ou end if...

Voici le code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim vcol As Integer

Dim vreponse As Integer

Dim vcellule As Object

If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then

Exit Sub

If Target.Value = "" Then

Exit Sub

vcol = Target.Column

If vcol = 3 Then

For Each vcellule In Range(Chr(vcol + 64) & ":" & Chr(vcol + 64))

If LCase(vcellule.Value) = LCase(Target.Value) And vcellule.Address <> Target.Address Then

vreponse = MsgBox("Cette donnée a déjà été introduite dans la base de donnée." & Chr(10) & "Voulez-vous la laisser?", vbYesNo + vbInformation, "Attention")

If vreponse = vbNo Then

Range(Target.Address).Activate

SendKeys "{F2}"

End If

Exit Sub

End If

If vcellule.Row > ActiveCell.SpecialCells(xlLastCell).Row Then

Exit Sub

Next

End If

End Sub

Merci de votre expertise et de m'avoir lu.

En attente de vos retours, je vous souhaite une bonne soirée.

10test2.xlsm (15.57 Ko)
Le 26/01/2015 à 22:55

bonsoir,

proposition de correction

utilise "worksheet_change" plutôt que "worksheet_selectionchange" + si tu passes à la ligne après un "then" tu dois mettre un "end -if"

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vcellule As Range
    If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then Exit Sub

    If Target.Value = "" Then Exit Sub

    For Each vcellule In Range(Chr(64 + Target.Column) & ":" & Chr(64 + Target.Column))
        If LCase(vcellule.Value) = LCase(Target.Value) And vcellule.Address <> Target.Address Then

            vreponse = MsgBox("Cette donnée a déjà été introduite dans la base de donnée." & Chr(10) & "Voulez-vous la laisser?", vbYesNo + vbInformation, "Attention")

            If vreponse = vbNo Then
                Application.EnableEvents = False
                Range(Target.Address).Delete shift:=xlUp
                Application.EnableEvents = True
            End If
            Exit Sub

        End If
        If vcellule.Row > ActiveCell.SpecialCells(xlLastCell).Row Then Exit Sub
    Next

End Sub
Le 26/01/2015 à 23:03

trouvé:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim vcol As Integer

Dim vreponse As Integer

Dim vcellule As Object

If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then Exit Sub

If Target.Value = "" Then Exit Sub

vcol = Target.Column

If vcol = 3 Then

For Each vcellule In Range(Chr(vcol + 64) & ":" & Chr(vcol + 64))

If LCase(vcellule.Value) = LCase(Target.Value) And vcellule.Address <> Target.Address Then

vreponse = MsgBox("Cette donnée a déjà été introduite dans la base de donnée." & Chr(10) & "Voulez-vous la laisser?", vbYesNo + vbInformation, "Attention")

If vreponse = vbNo Then

Range(Target.Address).Activate

SendKeys "{F2}"

End If

Exit Sub

End If

If vcellule.Row > ActiveCell.SpecialCells(xlLastCell).Row Then Exit Sub

Next

End If

End Sub

Merci pour ta réponse.

Ton code est plus sur que le mien. Je vais m'en inspirer ^^.

Merci pour ton transfert de connaissance à bientôt.

Bonne soirée.

Le 26/01/2015 à 23:21

Bonsoir JambonTomate, bonsoir le forum,

Les conditionnelles peuvent s'écrire sur une seule ligne : If Condition Then Résultat mais si tu écris :

If Condition Then
Résultat

Il te faut obligatoirement rajouter un End If

C'est le cas pour tes deux premières ligne (après les délarations de variables) :

If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then
Exit Sub
If Target.Value = "" Then
Exit Sub

remplace les par :

If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

je te propose ton code modifié qui agit non plus au changement de sélection dans l'onglet mais à l'édition dans une cellule de l'onglet (Change) :

Private TEST As Boolean 'déclare la variable TEST

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)

TC = Range("C1").CurrentRegion 'définit la tableau de cellules TC
If Target.Cells.Count > 1 Then Exit Sub 'si le nombre de cellules sélectionnées est supérieur à 1, sort de la procédure
If Target.Value = "" Then Exit Sub 'si la cellule est effacée, sort de la procédure
If Target.Column <> 3 Then Exit Sub 'si la colonne de la cellule éditée est différente de la colonne 3, sort de la procédure
If TEST = True Then Exit Sub 'si TEST est [Vrai], sort de la procédure
TEST = True 'définit la variable TEST
For I = 2 To UBound(TC, 1) 'boucle sur toutes les lignes du tableau TC (en partant de la seconde)
    'condition 1 : si la valeur en ligne I, colonne 1 du tableau TC (convertie en minuscule) est égale à la valeur
    'de la cellule éditée (convertie en minuscule) avec leur ligne différente
    If LCase(TC(I, 1)) = LCase(Target.Value) And I <> Target.Row Then
        Target.Select 'sélectionne la cellule éditée
        'condition 2 : si "Non" au message
        If MsgBox("Cette donnée a déjà été introduite dans la base de donnée." & Chr(10) & "Voulez-vous la laisser?", _
           vbYesNo + vbInformation, "Attention") = vbNo Then
            Target.Delete 'efface la cellule éditée (sans relancer la procédure [Change] à cause de la variable TEST)
            TEST = False: Exit Sub 'redéfinit TEST, sort de la procédure
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
TEST = False 'redéfinit TEST
End Sub

[Éditon]

Ooops ! 'ach'ment en r'tard moi... Bonsoir Alcid (Sulfuric)

Rechercher des sujets similaires à "probleme code next"