Incrémentation perdue suite à un changement de valeurs

Bonjour,

Je me trouve dans l'obligation de revenir encore une fois sur une solution VBA de notre camarade Thihii qui fonctionne correctement (voir copie de exemple2), le pb c'est que j'ai voulu changer les valeurs de colonne "resultat test" par vrai/faux au lieu de succes/echec

Pour ce faire, j'ai changé la liste déroulante par les nouvelles valeurs et modifier le code VBA en remplaçant la valeur "succes" par "vrai (voir exemple3) , cette modification a entraîné une perte de l'incrémentation dans la colonne G

Pouvez vous m'aider encore plus pour corriger les erreurs dans l'exemple3

Rappel: l'application permet d'incrémenter la colonne G en fonction des conditions suivantes:

• resultat test "succes" donne une incrémentation de la manière suivante 0001,0002,....
• resultat test "echec" , aucune incrémentation
• pour une modification de l'année, l'incrémentation recommence depuis 0001

cdlt

bonjour,

sasn avoir cherché à comprendre ce que fais le code,

essaie en remplaçant l'instruction

If Target.Value <> "vrai" Then Cells(Target.Row, ColIncrement) = "": GoTo lafin

par

If Target.Value <> "succes" Then Cells(Target.Row, ColIncrement) = "": GoTo lafin

Re

Tu veux dire remplacer "succes" par vrai et non pas le contraire

Notez bien que mon objectif c'est de remplacer les deux valeurs dans la liste déroulante "succes, echec" par les 2 valeurs "vrai, faux"

J'ai pris en compte votre réponse mais que faut il faire pour la ligne suivante:

If Trim(Cells(x, ColTest)) = "succes" Then

Faut il remplacer "succes" par "vrai"

cdlt

bonsoir,

je me suis emmeler les pinceaux. Il me semble que le classeur que tu as fourni fonctionne correctement.

peux-tu donner les instructions pour reproduire ce qui pose problème ?

Re

Le problème réside dans exemple3, le fichier qui fonctionne correctement est copie de exemple2 (1)

J'ai modifié les valeurs de colonne nommé "resultat test" par vrai, faux au lieu de succes,echec

J'ai modifié egalement le code VBA pour que l'incrementation fonctionne de la meme manière que le fichier exemple2 (1)

Cette dernière modification a porté sur 2 lignes (merci de verifier la modification)

Apres cette modification l'incrementation devient non fonctionnelle

Je comprends pas qu'est ce qu'il manque exactement

Cdlt

Bonjour,

comme je te l'ai dit,, l'incrémentation semble fonctionner (je vois des numéros s'afficher quand je mets une valeur vrai). mais commeje ne sais pas à quoi je dois m'attendre, je t'ai demandé les instructions pour reproduire le problème, le résultat que tu obtiens et le résultat attendu.

Peut-être la détection des événements n'est-elle pas activée ?

exécute la procédure réactiver_evenement.

Re,

Dommage sur le même fichier l'incrémentation ne fonctionne pas malgré que j'ai exécuté la procédure réactiver_evenement mais je comprends pas pq ça marche pas sur mon PC.

J'ai voulu juste partager avec vous une capture d'écran qui affiche un message d'erreur juste à coté de cellule D17 "la valeur dans cette cellule est non valide ou manquante", je sais pas si cette indication a un effet sur le résultat attendu, sinon que dois je faire dans ce cas

cdlt

Salut Seyf1981, H2SO4,

le problème vient de la mauvaise interprétation de tes données "VRAI - FAUX"...

Quand j'ai un problème quelconque, je fais comme le petit Poucet : je sème des MSGBOX partout pour piéger certaines valeurs.

Ta cellule donnait "Vrai" là où tu cherchais "vrai"!

If UCase(Target.Value) <> "VRAI"

Un peu de cohérence et, quand on ne peut être certain, UCASE règle de nombreux cas où l'hésitation est mortelle!

A+

Bonjour,

Après cette petite modification , le message d'erreur a disparu mais l'incrémentation ne fonctionne pas encore

ci ,joint le fichier

cdlt

Re

Je serais reconnaissant si quelqu'un peut m'aider

Juste pour rappeler la solution VBA a été proposé par notre camarade Thihii et qui fonctionne correctement avant que j'ai decidé de changer les valeurs dans la liste déroulante et modifier la valeur "succes " par "vrai" dans le code VBA,

Actuellement l'incrémentation ne fonctionne plus suite à cette modification

solution de Thihii:https://forum.excel-pratique.com/excel/fonction-incrementation-automatique-t98257-30.html

cdlt

Bonjour,

en prenant ton fichier exemple3.xlsm (ton premier message), si je sélectionne une valeur "vrai" en colonne D, j,ai bien un numéro qui s'incrémente en colonne G. N'est-ce pas le résultat souhaité ?

Re h2so4

Tout à fait c'est le résultat souhaité mais ça fonctionne pas sur mon PC

Si je sélectionne la valeur vrai en colonne D le numéro ne s'incrémente pas en colonne G

cdlt

re-bonjour,

vérifie que la procédure s'exécute bien

rajoute un msgbox dans ton code comme ceci, le message "la procédure s'exécute" devrait s'afficher lorsque tu sélectionnes une valeur en colonne D.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim plg As Range
    Dim tableau() As Long
    Dim Nbr As Long
    Dim annee As String
    Dim cherche
    Dim n As Long
    Dim li As Long
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim ColAnnee As Long
    Dim ColTest As Long
    Dim ColIncrement As Long
'   noter les n° de colonne respectivement pour :
'       ColTest pour la colonne du Résultat test
'       ColIncrement pour la colonne du Numéro d'incrémentation
'       ColAnnee pour la colonne de l'année
'
'   pour la col A noter 1 - pour la col B noter 2 - pour la col C noter 3
'   etc...
'
    ColTest = 4
    ColIncrement = 7
    ColAnnee = 2
'-------------------------- ici
    MsgBox "la procédure s'exécute"
'--------------------------
    Application.EnableEvents = False
    If Target.Column <> ColTest Then GoTo lafin
    If Target.Count > 1 Then GoTo lafin
    If Target.Value <> "vrai" Then Cells(Target.Row, ColIncrement) = "": GoTo lafin
    n = Cells(Rows.Count, ColAnnee).End(xlUp).Row
    annee = Cells(Target.Row, ColAnnee)
    Set plg = Range(Cells(4, ColAnnee), Cells(n, ColAnnee))
    Nbr = Application.CountIf(plg, annee)
    'le tableau est sur-dimensionné, pour éviter une erreur
    'dans la dernière boucle en fin de routine
    ReDim tableau(Nbr)
    li = plg.Find(annee, LookIn:=xlValues).Row - 1
    For Each cherche In Range(Cells(li, ColAnnee), Cells(n, ColAnnee))
        If cherche.Value = annee Then
            x = cherche.Row
                If Trim(Cells(x, ColTest)) = "vrai" Then
                        y = y + 1
                        z = Val(Cells(x, ColIncrement))
                        tableau(z) = x
                        If Cells(x, ColIncrement) = "" And z > 0 Then Cells(x, ColIncrement) = z: GoTo lafin
                End If
        End If
    Next cherche
    n = 0
    For x = 1 To y
        If tableau(0) > 0 Then
                If tableau(x) > 0 Then n = x
                If tableau(x) = 0 Then
                        Cells(tableau(0), ColIncrement) = x
                        GoTo lafin
                End If
        End If
    Next x
lafin:
    Application.EnableEvents = True
End Sub

Re,

le message box "la procédure s'exécute" s'affiche

cdlt

Bonjour,

veux-tu essayer avec ce fichier-ci ? et mettre une valeur vrai en D16, sans rien modifier d'autre ?

RE

Dommage ça fonctionne pas

ci joint une capture d’écran

cdlt

bonjour,

essaie ceci, je pense que dans une version excel FR, la chaine de caractères "vrai" est convertie en booléen VRAI.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim plg As Range
    Dim tableau() As Long
    Dim Nbr As Long
    Dim annee As String
    Dim cherche
    Dim n As Long
    Dim li As Long
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim ColAnnee As Long
    Dim ColTest As Long
    Dim ColIncrement As Long
'   noter les n° de colonne respectivement pour :
'       ColTest pour la colonne du Résultat test
'       ColIncrement pour la colonne du Numéro d'incrémentation
'       ColAnnee pour la colonne de l'année
'
'   pour la col A noter 1 - pour la col B noter 2 - pour la col C noter 3
'   etc...
'
    ColTest = 4
    ColIncrement = 7
    ColAnnee = 2
    Application.EnableEvents = False
    If Target.Column <> ColTest Then GoTo lafin
    If Target.Count > 1 Then GoTo lafin
    If Target.Value <> True Then Cells(Target.Row, ColIncrement) = "": GoTo lafin
    n = Cells(Rows.Count, ColAnnee).End(xlUp).Row
    annee = Cells(Target.Row, ColAnnee)
    Set plg = Range(Cells(4, ColAnnee), Cells(n, ColAnnee))
    Nbr = Application.CountIf(plg, annee)
    'le tableau est sur-dimensionné, pour éviter une erreur
    'dans la dernière boucle en fin de routine
    ReDim tableau(Nbr)
    li = plg.Find(annee, LookIn:=xlValues).Row - 1
    For Each cherche In Range(Cells(li, ColAnnee), Cells(n, ColAnnee))
        If cherche.Value = annee Then
            x = cherche.Row
                If Trim(Cells(x, ColTest)) = True Then
                        y = y + 1
                        z = Val(Cells(x, ColIncrement))
                        tableau(z) = x
                        If Cells(x, ColIncrement) = "" And z > 0 Then Cells(x, ColIncrement) = z: GoTo lafin
                End If
        End If
    Next cherche
    n = 0
    For x = 1 To y
        If tableau(0) > 0 Then
                If tableau(x) > 0 Then n = x
                If tableau(x) = 0 Then
                        Cells(tableau(0), ColIncrement) = x
                        GoTo lafin
                End If
        End If
    Next x
lafin:
    Application.EnableEvents = True
End Sub

Re

J'ai testé mais toujours ça marche pas

Je pense pas que c'est un problème de langue parce que j'ai modifié les valeurs de la liste par 1,2 au lieu de vrai, faux (ci joint)

cdlt

bonjour,

fichier modifié pour fonctionner avec 1 et 2.

Re

PARFAIT cette fois ça fonctionne pour ce dernier fichier

est ce que ça fonctionne aussi pour les deux valeurs oui, non

Que faut il faire ???

cdlt