Discussion :

[EricQ]

Bonjour !

Considérons 3 cellules appelées A, B et C qui contiennent initialement le chiffre 0.
L’utilisateur place une valeur dans A différente de 0.
Puis, il place une autre valeur différente de 0 dans B, celle qu’il avait placée dans A passe alors automatiquement à 0.
Si ensuite, il place une autre valeur dans C différente de 0, celle dans B passe à 0…etc

Donc ne jamais avoir plus d’une cellule avec une valeur différente de 0.

Qui veux bien m'aider à traduire en lignes informatiques cette idée ?

[tomy7]

bonjour,

Code :

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

1
2
3
4
5
6
Sub test()
If Sheet1.Range("A1").Value > "0" Then
Sheet1.Range("B1").Value = 0
Sheet1.Range("C1").Value = 0
End If
End Sub

tu fais pareil pour chaque cellule et c est bon je pense!

est ce que ca te convient?

[cafeine]

Hello,

voici une fonction générique qui s'applique à une plage de cellules nommée "toto", ça peut évidemment être adapté.

à mettre sur le code de la feuille concernée

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim c As Range
On Error GoTo smartExit
 
Application.EnableEvents = False
If Intersect(Target, Range("toto")) Then
    If Target.Value <> 0 Then
        For Each c In Range("toto").Cells
            If c.Address <> Target.Address Then
                c.Value = 0
            End If
        Next c
    End If
End If
 
smartExit:
Application.EnableEvents = True
 
Set c = Nothing
End Sub

[EricQ]

Merci cela marche impec !!!!

[House MD]

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Double
 
If Target > 0 Then
    A = Target.Value
    Cells(1, 1) = 0
    Cells(1, 2) = 0
    Cells(1, 3) = 0
    Target = A
End If
 
End Sub

[tomy7]

tu active sa avec un raccourci ou avec un bouton et c fini :

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 test()
If Sheet1.Range("A1").Value > 0 Then
Sheet1.Range("B1").Value = 0
Sheet1.Range("C1").Value = 0
End If
 
If Sheet1.Range("B1").Value > 0 Then
Sheet1.Range("A1").Value = 0
Sheet1.Range("C1").Value = 0
End If
 
If Sheet1.Range("C1").Value > 0 Then
Sheet1.Range("B1").Value = 0
Sheet1.Range("A1").Value = 0
End If
End Sub

mais le code de cafeine est peut meilleur ....ca depend de ton besoin!

[EricQ]

Merci pour les réponses rapides mais j'ai encore un petit problème.

En court : Y’a moyen de mettre un toto 2 ?

En long : Avec Range("A1:C1", "A2:C2") par exemple, il me remet à zero les valeurs sur les deux lignes alors qu’il faudrait qu’il le fasse ligne par ligne.

Any help, please.

[House MD]

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Str As String
 
If Target <> 0 Then
    str = Target.Value
    Cells(target.row, 1) = 0
    Cells(target.row, 2) = 0
    Cells(target.row, 3) = 0
    Target = str
End If
 
 
End Sub

[EricQ]

House MD : ton code marche bien ligne par ligne, le souci est que j'ai besoin de définir les cellules où une seule valeur peut être différente de 0.

le code de cafeine est OK mais pour l'appliquer sur chacune des 10 lignes en ne considérant que trois cellules par ligne, c'est là que cela bloque.

Est ce qu'il faut faire un truc comme cela (admettons qu'il n'y ait que deux lignes) ?

Code :

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

1
2
3
Dim r1 As Range, r2 As Range
Set r1 = Range("A1:C1")
Set r2 = Range("A2:C2")

Mais après, je sais pas

[cafeine]

Arf ... le besoin évolue au cours du temps ...
un peu d'adaptation s'impose :

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim c As Range
On Error GoTo smartExit
 
Application.EnableEvents = False
If Intersect(Target, Range("toto")) Then
    If Target.Value <> 0 Then
        For Each c In Range("toto").Cells
            If c.Row = Target.Row And c.Column <> Target.Column Then
                c.Value = 0
            End If
        Next c
    End If
End If
 
smartExit:
Application.EnableEvents = True
 
Set c = Nothing
End Sub

[ucfoutu]

Bonsoir,

Je vais dire une "bêtise" ...

Pourquoi ne pas mettre simplement en mémoire l'adresse de la cellule dans laquelle on met une autre valeur que 0
Il suffirait alors ensuite, dès que l'on donne à l'une quelconque des autres cellules une valeur différente de 0, de donner la valeur 0 à la cellule dont l'adresse est en mémoire, puis de mettre en mémoire cette dernière cellule....
Pas de boucle, de cette manière.

Bon... j'ai assez dit de "bêtises".
Je vais faire dodo ...

[EricQ]

ucfoutu ton idée semble judicieuse mais je suis pas assez calé pour la mettre sous forme de code.

j'ai finalement retenu le code de cafeine.

merci à tous pour votre participation

[EricQ]

Bonjour,
Voilà je ne sais pas si je dois créer un nouveau sujet mais comme c’est vraiment la continuité du problème précédent, je tente ma chance ici.
Le code de caféine, détaillé trois réponses avant celui-ci, fonctionne impeccablement.
Le programme permet parmi trois cellules adjacentes en ligne d’initialiser à 0, à chaque nouvelle valeur entrée dans l’une des cellules, les valeurs des autres cellules.
Je souhaite faire la même chose pour 2 autres cellules, non adjacentes entre elles, et sur la même ligne que les trois autres cellules. Les deux initialisations sont indépendantes.
J’espère que cela n’a pas déjà été traité sur le forum. Toutes mes excuses si c’est le cas.

Edit : c'est fait, j'ai retiré Résolu.

[fring]

Bonjour,

Et qu'est ce qui t'empêche de répéter le même code pour les deux autres cellules ?

[EricQ]

En essayant le code suivant, cela ne fait pas ce que j'attends.

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim c As Range
On Error GoTo smartExit
 
Application.EnableEvents = False
If Intersect(Target, Range("E13:G13, E14:G14")) Then
    If Target.Value <> 0 Then
        For Each c In Range("E13:G13, E14:G14").cells
            If c.Row = Target.Row And c.Column <> Target.Column Then
                c.Value = 0
            End If
        Next c
    End If
End If
 
smartExit:
Application.EnableEvents = True
 
Set c = Nothing
End Sub
Private Sub Worksheet_Changeb(ByVal Target As Range)
 
Dim d As Range
On Error GoTo smartExit
 
Application.EnableEvents = False
If Intersect(Target, Range("O13, Q13, O14, Q14")) Then
    If Target.Value <> 0 Then
        For Each d In Range("O13, Q13, O14, Q14").cells
            If d.Row = Target.Row And d.Column <> Target.Column Then
                d.Value = 0
            End If
        Next d
    End If
End If
 
smartExit:
Application.EnableEvents = True
 
Set d = Nothing
End Sub

[Godzestla]

Ou c'est moi qui ne comprends rien, ou alors quelque-chose t'a échappé.

C'est quoi ça :

Code :

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

1
2
Private Sub Worksheet_Changeb(ByVal Target As Range)

cela ne sera jamais exécuté. le code qui est la dedans est à intégrer dans

Code :

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

1
2
 
Private Sub Worksheet_Change(ByVal Target As Range)

qui s'exécute à chaque changement.

J'ai fumé la moquette ou pas ?

[fring]

Essaye ceci :

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 
On Error GoTo fin
If Not Application.Intersect(Target, Range("E13:G13,E14:G14")) Is Nothing Then
    If Target.Value <> 0 Then
        For Each c In Range("E13:G13,E14:G14")
            If c.Address <> Target.Address Then
                c.Value = 0
            End If
        Next c
    End If
End If
 
If Not Application.Intersect(Target, Range("O13,Q13,O14,Q14")) Is Nothing Then
    If Target.Value <> 0 Then
        For Each c In Range("O13,Q13,O14,Q14")
            If c.Address <> Target.Address Then
                c.Value = 0
            End If
        Next c
    End If
End If
 
fin:
End Sub

[EricQ]

merci fring
pour l'instant l'initialisation s'exécute sur l'ensemble des deux groupes de cellules et non pas ligne par ligne.
en essayant le code suivant, rien ne se passe

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 
On Error GoTo fin
Application.EnableEvents = False
If Intersect(Target, Range("E13:H13, E14:H14")) Then
    If Target.Value <> 0 Then
        For Each c In Range("E13:H13, E14:H14").cells
            If c.Row = Target.Row And c.Column <> Target.Column Then
                c.Value = 0
            End If
        Next c
    End If
End If
 
Application.EnableEvents = False
If Intersect(Target, Range("O13, Q13, O14, Q14")) Then
    If Target.Value <> 0 Then
        For Each c In Range("O13, Q13, O14, Q14").cells
            If c.Row = Target.Row And c.Column <> Target.Column Then
                c.Value = 0
            End If
        Next c
    End If
End If
 
fin:
End Sub

[fring]

les modifs doivent s'effectuer uniquement sur la même ligne ?
réexplique ce que tu souhaites obtenir stp

[EricQ]

1 - - - y y y - - - z - z
2 - - - y y y - - - z - z
3 - - - y y y - - - z - z
...

Pour chaque ligne :

parmi trois cellules adjacentes (y y y), initialiser à 0, à chaque nouvelle valeur entrée dans l’une des cellules, les valeurs des 2 autres cellules.

pour les deux cellules non adjacentes (z - z), initialiser à 0, à chaque nouvelle valeur entrée dans l’une des cellules, la valeur de l'autre cellule.

En espérant que cela est clair