étendre une formule à plusieurs colonnes

Esaliya Messages postés 1 Date d'inscription mercredi 11 août 2021 Statut Membre Dernière intervention 11 août 2021 - Modifié le 11 août 2021 à 19:29
cs_Le Pivert Messages postés 7824 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 6 octobre 2022 - 13 août 2021 à 16:11
Bonjour,

Je réalise un fichier d'inscription sur lequel :
- La colonne G représente une sessions sur laquelle il est possible de s'inscrire.
- Les inscriptions sont matérialisées par un "1" dans la plage G7:G78
- Le nombre d'inscription dépend de la capacité maximale de la salle (cellule G4)
Par exemple : si une salle peut accueillir maximum 6 personnes, seulement 6 cellules dans la plage G7:G78 pourront contenir un "1". Les autres sont bloquées à partir de la 7ème entrée.

En naviguant sur des forums j'ai réussi à trouver ce codage VBA qui fonctionne très bien pour ma colonne G :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Selection, Range("G4:G78")) Is Nothing Then
If [G79] > [G4] Then Application.Undo
End If
End Sub


Le problème étant qu'il n'y a pas qu'une seule date proposée, mais plusieurs - allant de la colonne G à x (variable).
Je souhaiterai pouvoir étendre ma formule VBA à l'ensemble de mes colonnes, tout en conservant les particularités de chaque colonne, par exemple pour la colonne H si la salle peut accueillir maximum 5 personnes (cellule H4), seulement 5 cellules dans la plage H7:H78 pourront contenir un "1". Les autres sont bloquées à partir de la 6ème entrée. etc.

J'ai voulu copier/coller ce code à la suite en modifiant les lettres des colonnes, sans succès.

Pourriez-vous m'aider s'il vous plait ?

Bonus : Est-il possible d'afficher une fenêtre pop-up (message box) lorsqu'un utilisateur saisit une valeur hors limite (par exemple essaie d'inscrire une 7 ème personne à une session limitée à 6) ? Si oui, comment ?

Merci par avance !

1 réponse

cs_Le Pivert Messages postés 7824 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 6 octobre 2022 134
Modifié le 13 août 2021 à 16:40
Bonjour,

suivant ce que j'ai compris, à adapter

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nbcells As Integer 'nombre de cellules remplies dans la colonne
Dim col As String 'colonne en lettre
If Not Application.Intersect(Target, Range(Rows(7), Rows(78))) Is Nothing Then 'lignes à traiter
If Cells(4, Target.Column) = "" Then 'en dehors des limites
Target.Value = ""
Exit Sub
Else
col = Split(Columns(Target.Column).Address(ColumnAbsolute:=False), ":")(1) 'colonne en lettre
nbcells = Application.WorksheetFunction.CountA(Feuil1.Range(col & ":" & col)) 'nombre de cellules remplies dans la colonne
If nbcells > Cells(4, Target.Column) Then
MsgBox "stop"
End If
End If
End If
End Sub


0