XL 2019 Cocher les cases pour répondre.

[Paulle]

Bonjour,

Actuellement un clic sur les cellules de la colonne B insert un X et copie la valeur de la colonne C en A. Un second clic l'efface.

Je souhaiterai qu'il ne soit possible que de cocher les cellules B10àB14, B17àB21, B24àB28 ……..B117àB119.

Je vais essayer d'expliquer avec un exemple.
Actuellement deux réponses sont possibles par question. Je souhaiterai qu'une seule soit possible.
Je clique B13 si je me rends compte que la réponse correspond à B10. Quand je clique B10, B13 s'efface.

Je souhaiterai associer le bouton "Réinitialiser "à une macro effaçant les X en colonne B.

La somme de la colonne A est en D122.

Le code vba actuel n'est pas de moi. Il est de Phil69970 que j'ai adapté.

Merci pour l'aide que vous pourrez m'apporter.

 

[job75]

Bonjour Paulle,

Actuellement deux réponses sont possibles par question.

Actuellement on peut cocher B10 B11 B12 B13 B14 ça fait 5 et pas 2 ???

A+

 

[Paulle]

Bonjour Paulle,


Actuellement on peut cocher B10 B11 B12 B13 B14 ça fait 5 et pas 2 ???

A+

 

[Paulle]

Oui, c'est pas 2 mais plusieurs.

 

[job75]

Pour qu'une seule cellule de chaque groupe soit cochée utilisez :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 2 And IsNumeric(CStr(Target(1, 2))) Then
    Intersect(Target(1).CurrentRegion, [C:C].SpecialCells(xlCellTypeConstants, 1)).Offset(, -2).Resize(, 2).ClearContents
    Target(1) = "X"
    Target(1, 0) = Target(1, 2)
End If
End Sub

Pour tout effacer :

Sub Reinitialiser()
Intersect([A:B], [C:C].SpecialCells(xlCellTypeConstants, 1).EntireRow).ClearContents
End Sub

 

[Paulle]

Merci Job,

Je viens de tester avec mon fichier original et c'est impeccable.

Bonne soirée.

 

[Paulle]

J'ai testé plus à fond, et il y a un bug.

De B36 à B43 il est impossible de cocher les cellules.

 

[job75]

Bonjour Paulle, le forum,

De B36 à B43 il est impossible de cocher les cellules.

En A39 il y a une formule, enlevez-la.

A+

 

[job75]

On peut éviter le bug avec :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 2 And IsNumeric(CStr(Target(1, 2))) Then
    Intersect([A:B], Intersect(Target(1).CurrentRegion, [C:C].SpecialCells(xlCellTypeConstants, 1)).EntireRow).ClearContents
    Target(1) = "X"
    Target(1, 0) = Target(1, 2)
End If
End Sub

Mais alors les plages A36:B38 et A41:B43 sont effacées ensemble ce qui est un autre inconvénient.

Il vaut donc mieux rester sur la solution du post #5, elle permet de voir l'erreur.

 

[Paulle]

La formule enlevée, tout rentre dans l'ordre.

Je pense à une autre solution.
Supprimer la colonne A.
Faire la somme des cellules colonne B qui ont sur la même ligne une cellule cochée colonne A .

 

[job75]

Je pense à une autre solution.
Supprimer la colonne A.
Faire la somme des cellules colonne B qui ont sur la même ligne une cellule cochée colonne A .

Pas de problème, voici le nouveau code :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And IsNumeric(CStr(Target(1, 2))) Then
    Intersect(Target(1).CurrentRegion, [B:B].SpecialCells(xlCellTypeConstants, 1)).Offset(, -1).ClearContents
    Target(1) = "X"
End If
End Sub

Sub Reinitialiser()
Intersect([A:A], [B:B].SpecialCells(xlCellTypeConstants, 1).EntireRow).ClearContents
End Sub

et la formule en C122 =SOMME.SI(A:A;"X";B:B)

 

[Paulle]

Merci et bonne journée.