Discussion :

[chevalba]

Bonjour le forum, bonjour à toi, qui va lire mon sujet et m'aider,

J'ai un tableau 6x5 commençant en B3 (la dernière ligne commence à B8 et la dernière colonne à G3) et j'aimerais ne pouvoir rentrer qu'une seule valeur sur chaque ligne. J'ai déjà écrit un code, dans le sub worksheet_change, pour n'autoriser que 2 types de données: "x" ou "" (rien). Et donc je ne veux pas 2 fois "x" dans une ligne de mon tableau.

Comme fonctionnement général du code, j'aimerais que lorsque l'utilisateur rentre un "x" dans une ligne en contenant déjà un, un message d'erreur s'affiche et la cellule qui vient d'être remplie est vidée.

Voilà ce que j'ai essayé de faire jusqu'à présent mais je rentre dans une boucle infinie et je ne vois pas du tout comment m'orienter pour régler ce souci et pour obtenir le fonctionnement que je désire:

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
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ligne As Range, CopieLigne as Variant
 
    If Not Intersect(Target, Range("tableau")) Is Nothing Then            'Si le changement de valeur est fait dans le tableau...
        For Each Ligne In Range("tableau").Rows                                'Pour chaque ligne du tableau...
              CopieLigne=Ligne.Value                                                 'Je garde la valeur de la ligne quelque part (ça marche de l'écrire comme ça?) 
              If Not IsEmpty(Ligne.Value) Then                                    'Si la ligne n'est pas vide (dans le cas où la ligne n'est pas vide cela signifie qu'il y
                                                                                               'a forcément une croix dans une des cases donc ça suffit à distinguer mes 2 cas: 
                                                                                               'une case est déjà remplie ou aucune n'est remplie)
                    Application.EnableEvents = False                               'Je désactive les events car je vais changer la valeur de la ligne
                    MsgBox ("Une seule case par ligne doit être remplie")
                    Ligne.Value=CopieLigne                                           'Je remets l'ancienne ligne pour ne pas que l'utilisateur puisse changer les valeurs des cases
                    Application.EnableEvents = True                                'Je réactive les events
            End If
        Next
    End If
End Sub

En te remerciant par avance pour l'intérêt porté à cette discussion et pour toute aide! (les liens vers d'autres explications sont les bienvenus également)
Bonne journée,

Bastien

[Marc-L]

Bonjour !

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
Private Sub Worksheet_Change(ByVal Target As Range)
        Dim Rg As Range, Ru As Range
        Set Rg = Intersect(Target, [B3:G8])
     If Not Rg Is Nothing Then
        Application.EnableEvents = False
            For Each Ru In Rg
                If Application.CountA(Cells(Ru.Row, 2).Resize(, 6)) > 1 Then
                    Ru.ClearContents
                    Beep
                End If
            Next
        Application.EnableEvents = True
        Set Rg = Nothing
     End If
End Sub

_________________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

_________________________________________________________________________________________________________

Je suis Paris, Nice, Bruxelles, Charlie, …

[joe.levrai]

Bonjour,

une autre proposition, qui intègre la gestion du "" ou "x"

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
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Asupp As Boolean
    If Not Intersect(Target, Range("tableau")) Is Nothing Then
        If Target.Value <> "" And Target.Value <> "x" Then
            MsgBox ("Seule des x est des cellules vides sont possibles")
            Asupp = True
        ElseIf Application.WorksheetFunction.CountA(Range("tableau").Rows(Target.Row - 2)) > 1 Then
            MsgBox ("Une seule case par ligne doit être remplie")
            Asupp = True
        End If
 
        If Asupp Then
            Application.EnableEvents = False
            Target.ClearContents
            Application.EnableEvents = True
        End If
    End If
End Sub

Si le x est valide également en majuscule, ajouter Option Compare Text tout en haut du module

[eriiic]

Bonjour,

une simple validation de données sur la plage avec ça ne suffit pas ?

Code :

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

=ET(NBVAL($B3:$G3)<2;NB.SI($B3:$G3;"x")<2)

eric

edit: complétée, oubli de refuser les autres saisies que "x"

[patricktoulon]

une solution simple et efficace en vba

tu ne peut avoir qu'une seule cellule écrite de a a g sur la même ligne

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
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Value = "" Then Exit Sub
    Set intsect = Application.Intersect(Range("B3:G8"), Target) 'si la cellule modifiée se trouve dans b3:g8
        If Not intsect Is Nothing Then
             ligne = Range(Cells(Target.Row, 2), Cells(Target.Row, 7))
            res = Join(Application.WorksheetFunction.Index(ligne, 0, 0), "")
            Debug.Print res
            ' maintenant on peut comparer res a ce que tu souhaite
            'par exemple ici
            If res <> Target.Text Then   ' si res <> de  la cellue modifiée alors il y a autre chose sur la ligne
                MsgBox "oulah!!! mon pot t'é miro "
                Target.Value = ""
            End If
        End If
 
End Sub

[Marc-L]

Oui Eric tu as raison : pas besoin de code !

Mais comme le demandeur en avait déjà commencé un, nous lui avons juste démontré
qu'une simple formule de calculs d'Excel permet de vérifier la ligne même en VBA …

[chevalba]

Bonjour, et merci pour toutes vos propositions!

Bonjour,

une simple validation de données sur la plage avec ça ne suffit pas ?

Code :

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

=ET(NBVAL($B3:$G3)<2;NB.SI($B3:$G3;"x")<2)

eric

edit: complétée, oubli de refuser les autres saisies que "x"

Bonjour Eric,

Avec cette méthode, il faudrait faire une validation de données sur chaque ligne et je trouve ça long et embêtant, surtout si je suis amené à modifier certaines dimensions du tableau,etc... à l'avenir. L'avantage que je vois à le coder en VBA est de pouvoir modifier rapidement mes paramètres. Et ma curiosité m'a poussé à le tenter en VBA

Bonjour !
Code :

Yes, super merci Marc-L! C'est le type de code que je cherchais, je n'arrivais pas à savoir comment gérer le compte des cellules ayant du contenu, et je n'avais pas pensé à me tourner vers cette solution (se servir du fait qu'une cellule n'est, de toute manière, remplie qu'avec un "x" ou "", j'aime beaucoup!).

Bonjour,

une autre proposition, qui intègre la gestion du "" ou "x"

Code :

Merci Joe, idem que pour Marc-L

une solution simple et efficace en vba

tu ne peut avoir qu'une seule cellule écrite de a a g sur la même ligne

Merci Patrick pour tes deux propositions, idem qu'au-dessus

Merci, passez une bonnes semaine!

[eriiic]

Bonjour,

Avec cette méthode, il faudrait faire une validation de données sur chaque ligne et je trouve ça long et embêtant

Heu non.
Si tu regardes bien la formule tu vois que tu peux l'appliquer en une fois sur toute la plage.
eric