XL 2019 Mettre un "X" automatiquement dans une cellule selon critères valeurs sur la même ligne

[ced91300]

Bonjour à tous,

j'aurai besoin via (Macro) à ce que que dans une colonne s'affiche automatiquement "X" selon plusieurs critères des valeurs se trouvant sur la même ligne.

merci de votre aide.

Cordialement

Cédric

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @ced91300
Je re propose une solution par formule et non vba :
En K3
=SI(($A3="X")*($B3="MAISON")*(($C3="AA")+($C3="BB")+($C3="CC"));"X";"")
Je suis sur mon téléphone, je ne peux pas écrire de macro ...
Voir pièce jointe
À bientôt

 

[ced91300]

Merci Alain, mais j'ai besoin que cela soit réalisable via la macro qui sera associé à d'autres.

Cordialement

Cédric

 

[AtTheOne]

Re,
J'ai récuoéré mon PC, voici une version via macro :
le code dans le code de la feuil1 :

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim lgn As Long
     If Target.Count = 1 And InStr("-1-2-3-11-", "-" & Target.Column & "-") <> 0 Then
          Application.EnableEvents = False
          lgn = Target.Row
          If UCase(Me.Cells(lgn, 1)) = "X" And UCase(Me.Cells(lgn, 2)) = "MAISON" And InStr("-AA-BB-CC-", "-" & UCase(Me.Cells(lgn, 3)) & "-") <> 0 _
          Then
               Me.Cells(lgn, 11) = "X"
          Else
               Me.Cells(lgn, 11).ClearContents
          End If
          Application.EnableEvents = True
     End If
End Sub

voir le fichier joint

 

[ced91300]

Merci Alain mais ta solution semble ne pas fonctionner (rien ne se passe)

 

[AtTheOne]

Bonsoir @ced91300
Bon, sur mon pc ça fonctionne :

Le code est-il au bon endroit :

Les événements ne sont-ils pas bloqués ?
Si c'est le cas la macro ne peut pas se dérouler, réactive les avec cette petite macro :
Sub ActiveEvents()

Application.EnableEvents=True​

End Sub

Sinon je ne vois pas ...
Je joins de nouveau le fichier que je viens de tester.

A bientôt
EDIT : Orthographe !!!

 

[job75]

Bonjour ced91300, AtTheOne,

Une autre solution avec cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, i&, x
With Range("A1", UsedRange).Resize(, 11)
    tablo = .Value 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        x = tablo(i, 3)
        tablo(i, 11) = IIf(tablo(i, 1) = "X" And tablo(i, 2) = "MAISON" And (x = "AA" Or x = "BB" Or x = "CC"), "X", "")
    Next
    Application.EnableEvents = False
    .Columns(11) = Application.Index(tablo, , 11)
    Application.EnableEvents = True
End With
End Sub

Elle se déclenche quand on modifie ou valide une cellule quelconque.

Elle est très rapide car elle utilise un tableau VBA.

Nota : la casse est respectée.

A+

 

[job75]

Pour tester j'ai recopié le tableau A3:K12 sur 100 000 lignes.

Chez moi la macro s'exécute en 0,34 seconde.

 

[AtTheOne]

Bonsoir @job75 , j'ai testé, c'est top
A bientôt

 

[ced91300]

Bonsoir @ced91300
Bon, sur mon pc ça fonctionne :
Regarde la pièce jointe 1197118

Le code est-il au bon endroit :
Regarde la pièce jointe 1197119

Les événements ne sont-ils pas bloqués ?
Si c'est le cas la macro ne peut pas se dérouler, réactive les avec cette petite macro :
Sub ActiveEvents()

Application.EnableEvents=True​

End Sub

Sinon je ne vois pas ...
Je joins de nouveau le fichier que je viens de tester.

A bientôt
EDIT : Orthographe !!!

Bonsoir @ced91300
Bon, sur mon pc ça fonctionne :
Regarde la pièce jointe 1197118

Le code est-il au bon endroit :
Regarde la pièce jointe 1197119

Les événements ne sont-ils pas bloqués ?
Si c'est le cas la macro ne peut pas se dérouler, réactive les avec cette petite macro :
Sub ActiveEvents()

Application.EnableEvents=True​

End Sub

Sinon je ne vois pas ...
Je joins de nouveau le fichier que je viens de tester.

A bientôt
EDIT : Orthographe !!!

bonsoir, oui merci effectivement cela fonctionne impeccablement.

En revanche, je souhaite l'avoir à la suite d'un vba déjà existant dans module et non dans la feuille (j'ai 30 feuilles identique) et quand je lance le vba cela m'efface certains résultats donnés par ta solution.

Merci

 

[ced91300]

Bonjour ced91300, AtTheOne,

Une autre solution avec cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, i&, x
With Range("A1", UsedRange).Resize(, 11)
    tablo = .Value 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        x = tablo(i, 3)
        tablo(i, 11) = IIf(tablo(i, 1) = "X" And tablo(i, 2) = "MAISON" And (x = "AA" Or x = "BB" Or x = "CC"), "X", "")
    Next
    Application.EnableEvents = False
    .Columns(11) = Application.Index(tablo, , 11)
    Application.EnableEvents = True
End With
End Sub

Elle se déclenche quand on modifie ou valide une cellule quelconque.

Elle est très rapide car elle utilise un tableau VBA.

Nota : la casse est respectée.

A+

Merci job75

serait-il possible d'avoir la solution dans un module (à la suite d'un VBA déjà existant j'ai 30 feuilles identique) et non dans la feuille pour que cette action se lance en dernier

Merci

 

[AtTheOne]

serait-il possible d'avoir la solution dans un module (à la suite d'un VBA déjà existant j'ai 30 feuilles identique) et non dans la feuille pour que cette action se lance en dernier

Dans ce cas, il faut utiliser la solution de @job75 qui parcourt toute la plage de donnée :
Code

Sub ContrôleSaisie(sh As Worksheet)

Dim tablo, i&, x
     With sh.Range("A1", sh.UsedRange).Resize(, 11)
          tablo = .Value 'matrice, plus rapide
          For i = 1 To UBound(tablo)
               x = tablo(i, 3)
               tablo(i, 11) = IIf(tablo(i, 1) = "X" And tablo(i, 2) = "MAISON" And (x = "AA" Or x = "BB" Or x = "CC"), "X", "")
          Next
          Application.EnableEvents = False
          .Columns(11) = Application.Index(tablo, , 11)
          Application.EnableEvents = True
     End With

End Sub

Sub Appel()
Dim sh As Worksheet
     For Each sh In ThisWorkbook.Worksheets
          'Placer un test ici si toutes les feuilles ne sont pas a traiter par ex
          If sh.Name Like "Tst_##" Then
               ContrôleSaisie sh
          Else
          End If
     Next
End Sub

Voir fichier joint

 

[ced91300]

j'ai pu l'adapter à mon fichier, merci à tous les 2 pour votre aide.
Cordialement