Microsoft 365 Sur 4 cellules voisines je souhaite ne permettre d'écrire que dans une

[Bertrand2235]

Bonjour, je travaille sur un tableau ou je souhaite que les utilisateurs ne puissent écrire que dans l'une des 4 cellules voisines.
C'est à dire que l'utilisateur peut saisir une valeur dans n'importe laquelle des 4 cellules, mais s'il entre une valeur dans la cellule C4 il ne pourra plus écrire dans les 3 autres cellules soit D4, E4 et F4.
soit dans le fichier joint :
de C4 à F4 et C5 à F5 jusqu'à C18 à F18...
de G4 à J4 ...
de K4 à N4 ...
de O4 à R4 ... O18 à R18

merci pour votre aide

 

[sylvanu]

Bonjour Bertrand,
Une idée en PJ avec cet essai :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("C4:R18")) Is Nothing Then
        Droits = 0
        Colonne = Target.Column
        Select Case Colonne
            Case 3, 4, 5, 6
                Contenu = Cells(Target.Row, 3) & Cells(Target.Row, 4) & Cells(Target.Row, 5) & Cells(Target.Row, 6)
                If Contenu = "" Then Droits = 1
            Case 7, 8, 9, 10
                Contenu = Cells(Target.Row, 7) & Cells(Target.Row, 8) & Cells(Target.Row, 9) & Cells(Target.Row, 10)
                If Contenu = "" Then Droits = 1
            Case 11, 12, 13, 14
                Contenu = Cells(Target.Row, 11) & Cells(Target.Row, 12) & Cells(Target.Row, 13) & Cells(Target.Row, 14)
                If Contenu = "" Then Droits = 1
            Case 15, 16, 17, 18
                Contenu = Cells(Target.Row, 15) & Cells(Target.Row, 16) & Cells(Target.Row, 17) & Cells(Target.Row, 18)
                If Contenu = "" Then Droits = 1
        End Select
        If Droits = 1 Then
            Target = "X"
        Else
            Cells(Target.Row, 2).Select
        End If
    End If
End Sub

Si les 4 cellules sont vides on met un X sur la case cliquée, si ce n'est pas le cas on déplace le curseur en colonne B.

 

[djidji59430]

Bonjour à tous,

une autre façon !

 

[soan]

Bonjour,

Je propose le fichier ci-dessous.

Option Explicit

Private Function PlgNb(chn$, lig&) As Byte
  PlgNb = Application.CountA(Range(Left$(chn, 1) & lig & ":" & Right$(chn, 1) & lig))
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
    If .CountLarge > 1 Then Exit Sub
    Dim lig&: lig = .Row: If lig < 4 Then Exit Sub
    Dim col%, n As Byte: col = .Column
    Select Case col
      Case Is < 3: Exit Sub
      Case Is < 7: n = PlgNb("CF", lig)
      Case Is < 11: n = PlgNb("GJ", lig)
      Case Is < 15: n = PlgNb("KN", lig)
      Case Is < 19: n = PlgNb("OR", lig)
    End Select
    Application.EnableEvents = 0
    If n = 2 Then .Value = Empty
    Application.EnableEvents = -1
  End With
End Sub

important : si tu ajoutes d'autres lignes sous la ligne 18, elles seront prises
en compte automatiquement, sans devoir changer le code VBA ; mais si
tu ajoutes d'autres colonnes à droite, il faudra faire une adaptation.
(mais une adaptation minime : il suffira d'ajouter une ligne dans le Select Case col)

soan

 

[soan]

ajout : si tu préfères une solution sans macro VBA, prends plutôt la solution
de @djidji59430 ; mais tu devras compléter les Validations de données
pour le critère 3 (colonnes K:N) et le critère 4 (colonnes O:R).

en cas de donnée saisie en trop, mon code VBA n'affiche pas de message
d'erreur ; il supprime purement et simplement la donnée saisie en trop ;
donc s'il faut mettre une donnée dans une autre colonne, il faut d'abord
effacer l'ancienne donnée avant de saisir la nouvelle donnée.

soan

 

[Bertrand2235]

Merci pour les réponses rapides et pertinentes.
sylvanu la macro insérant une donnée fait gagner du temps
djidji59430 cette solution simple et efficace, merci pour l'idée et le partage

 

[soan]

@Bertrand2235

tu n'as pas essayé aussi le fichier de mon post #4 ?

(et puis tu as aussi la solution de job75 ci-dessous)

soan

 

[job75]

Bonjour Bertrand2235, sylvanu, djidji59430, soan,

La méthode de djidji59430 va bien mais peut être contournée par du copier-coller, voyez ce fichier :

Private Sub Worksheet_Change(ByVal Taarget As Range)
Dim r As Range, i%
For Each r In [C4:R18].Rows 'plage à adapter
    For i = 1 To r.Cells.Count Step 4
        If Application.CountA(r.Cells(i).Resize(, 4)) > 1 Then
            With Application
                .EnableEvents = False
                .Undo
                .EnableEvents = True
            End With
            Exit Sub
        End If
Next i, r
End Sub

A+

 

[Bertrand2235]

@Bertrand2235

tu n'as pas essayé aussi le fichier de mon post #4 ?

(et puis tu as aussi la solution de job75 ci-dessous)

soan

j'ai essayé, toutes les solutions proposées, j'avoue que j'ai du mal avec les macros et la solution par validation de données me va tout à fait.
Encore merci

 

[soan]

ok, merci pour ton retour d'infos, et bonne continuation !

soan