étendre une formule à plusieurs colonnes

Question

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 !

cs_Le Pivert · Answer

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

étendre une formule à plusieurs colonnes

1 réponse

Votre réponse

Discussions similaires