Cel inhoud wijzigen maar beperken tot specifieke waarde

[samabert]

Hallo,

Indien in een cel een " X " staat kan je naderhand deze cel toch nog wijzigen in een andere waarde.
Deze " X " komt er door de code in het werkblad. Tot zover alles in orde.

Mijn vraag:
De cellen met " X " zouden naderhand alleen mogen gewijzigd worden in waarde 1 of 2.

Ik heb gezocht naar een formule in gegevensvalidatie, maar dat lukt mij niet. Zou dit op een of andere manier kunnen aangepast worden?

Alvast bedankt.
Marc

 

[VenA]

Zoiets?

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rng As Range, i As Long, j As Long, cell As Range, rCell As Range, nieuw, oud
  If Intersect(Target, Range("B6:AF6").Resize(lEmp)) Is Nothing Then Exit Sub
  With Application
    .EnableEvents = False
    nieuw = Target.Value
    .Undo
    oud = Target.Value
    If oud = "X" And nieuw <> 1 And nieuw <> 2 Then Target.Value = oud Else Target.Value = UCase(nieuw)
    Set Rng = Cells(6, Target.Column).Resize(lEmp)
    If .CountBlank(Rng) + .Min(.CountIf(Rng, 1), 2) + .Min(.CountIf(Rng, 2), 2) <= 5 And .CountBlank(Rng) > 0 Then Rng.SpecialCells(xlCellTypeBlanks).Value = "X"
    .EnableEvents = True
  End With
End Sub

 

[samabert]

VenA,

Knap gedaan, hetgeen ik vroeg heb je mooi opgelost, het werkt helemaal.:thumb:

Met het testen ervan kom ik nu wel een nieuw probleem tegen:
Even een uitleg hoe het werkt, we hebben voor elke shift 2 personen nodig. Dus als een dag compleet is heb je 2x1, 2x2 en 2x3 wat staat voor morgen, middag en nacht shift.

Nu als er al wat gewisseld is kan je hebben dat alles compleet is maar dat er toch nog enkele "X" staan omdat je deze niet kan verwijderen.
Is er een mogelijkheid om dat op een bepaalde manier te bypassen zodat deze cellen met "X" dan toch nog leeggemaakt kunnen worden om van een ander invoer te voorzien? Op het originele bestand moet er persoonlijk ingelogd worden of algemeen via verantwoordelijke.

In het nieuwe bijgevoegde voorbeeld zie je deze situatie op zondag 1 januari.

Indien dit niet kan, toch enorm bedankt voor je oplossing!
Mvg.
Marc

 

[VenA]

probeer het zo eens

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rng As Range, i As Long, j As Long, cell As Range, rCell As Range, nieuw, oud
  If Intersect(Target, Range("B6:AF6").Resize(lEmp)) Is Nothing Then Exit Sub
  With Application
    .EnableEvents = False
    nieuw = Target.Value
    .Undo
    oud = Target.Value
    Set Rng = Cells(6, Target.Column).Resize(lEmp)
    If oud = "X" And nieuw <> 1 And nieuw <> 2 And .Sum(Rng) <> 12 Then Target.Value = oud Else Target.Value = UCase(nieuw)
      If .CountBlank(Rng) + .Min(.CountIf(Rng, 1), 2) + .Min(.CountIf(Rng, 2), 2) <= 5 And .CountBlank(Rng) > 0 Then Rng.SpecialCells(xlCellTypeBlanks).Value = "X"
    .EnableEvents = True
  End With
End Sub

 

[samabert]

Super, werkt geweldig!

Nogmaals bedankt voor jouw hulp :d

Mvg.
Marc