maximaal aantal in te vullen cellen in een reeks

[Gerald Baalhuis]

Ik ben een beetje aan het klooien met een WK pool (wie niet?). Deelnemers kunnen op een werkblad bij een vraag aankruisen welke landen er door gaan naar de volgende rondes.
Dus 16 landen naar 2e ronde, 8 landen naar kwart finale, 4 landen naar halve finale, 2 naar finale.
Ik wil nu een reeks cellen (32, alle deelnemende landen) zodanig 'opmaken' dat je in die kolommen maximaal resp. 16, 8, 4 en 2 kruisje kunt zetten. Enig idee of dit mogelijk is?

 

[Roncancio]

Onderstaande code start als er een wijziging plaatsvindt in de A-kolom op het werkblad.
De code telt het aantal "x" in het bereik A1 t/m A32.
Is dat aantal groter dan 16 dan verschijnt er een melding.
Bovendien wordt de laatste toegevoegde "x" verwijderd.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Aantal = Application.WorksheetFunction.CountIf(Range("A1:A32"), "x")
If Aantal > 16 Then
MsgBox "U kunt niet meer dan 16 landen selecteren", vbInformation, "Teveel landen geselecteerd"
Target = ""
End If
End If
End Sub

 

[Gerald Baalhuis]

Ronancio,

Ik ben een leek op gebied van VB, dus ik waag nog maar een paar vraagjes over de code die je plaatste:

De reeksen die gecheckt moeten worden zijn:
voor de 16 landen: AB68 t/m AB99
in jouw code waarschijnlijk
If Target.Column = 1 wijzigen in 28
en de CountIf range in AB68:AB99

en kan ik dan de code voor 8, 4 en 2 landen ook opnemen in dit stukje VB?

Omdat ik net zoveel tabbladen met deze kolommen hab als er deelnemers zijn, moet ik dan telkens deze code in elk werkblad plakken met Alt-F11, of is er ook een overkoepelend "werkblad" (er staan al diverse stukjes VB in dit Excel bestand, dankzij dit fantastische forum). Ik weet niet of dat beperkend is...

 

[Roncancio]

Bedoel je dit:
In de rijen 68 t/m 99 van de actieve kolom (als het een van de kolommen tussen AB en AE betreft), worden het aantal "x" gecontroleerd.
Is dat aantal te hoog dan verschijnt er een melding.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Aantal As Integer
Dim Teveel As Boolean

Aantal = Application.WorksheetFunction.CountIf(Range(Cells(68, Target.Column), Cells(99, Target.Column)), "x")

Select Case Target.Column
Case 28
If Aantal > 16 Then
Teveel = True
End If
Case 29
If Aantal > 8 Then
Teveel = True
End If
Case 30
If Aantal > 4 Then
Teveel = True
End If
Case 31
If Aantal > 2 Then
Teveel = True
End If
End Select
If Teveel = True Then
MsgBox "U kunt niet meer dan " & Aantal - 1 & " landen selecteren", vbInformation, "Teveel landen geselecteerd"
Target = ""
End If

End Sub

Bovenstaande geldt voor 1 werkblad.
Wil je dat dit voor ALLE werkbladen geldt (dat is mij niet helemaal duidelijk), dan dien je de code te plaatsen in ThisWorkbook.
Ter vervolledigheid:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Aantal As Integer
Dim Teveel As Boolean
Aantal = Application.WorksheetFunction.CountIf(Range(Cells(68, Target.Column), Cells(99, Target.Column)), "x")
Select Case Target.Column
Case 28
If Aantal > 16 Then
Teveel = True
End If
Case 29
If Aantal > 8 Then
Teveel = True
End If
Case 30
If Aantal > 4 Then
Teveel = True
End If
Case 31
If Aantal > 2 Then
Teveel = True
End If
End Select
If Teveel = True Then
MsgBox "U kunt niet meer dan " & Aantal - 1 & " landen selecteren", vbInformation, "Teveel landen geselecteerd"
Target = ""
End If

End Sub