Si la cellule contient un mot

Version imprimable

22/12/2020, 10h21
Beehappy

Si la cellule contient un mot

Bonjour les développeurs,
Je fais mes premiers petits pas en VBA pour résoudre mes problèmes EXCEL !

Je voudrais développer un code pour saisie automatique!

Je m'explique : par exemple j'ai un petit tableau avec les cellules A1, B1 et C1, si je saisis le mot "Pomme" dans A1, automatiquement EXCEL affiche rouge dans les cellules B1 et C1.

Merciiiiiii !!!!
22/12/2020, 10h24
BENNASR

et pourquoi VBA si c'est pas pour apprentissage
il y a les règles de mise en forme conditionnelles MFC
22/12/2020, 10h25
Beehappy

C'est pour apprentissage !
22/12/2020, 10h26
BENNASR

et vous avez opté pour worksheet_change ou un code dans l'autre discussion ??
22/12/2020, 10h27
Beehappy

Worksheet change

à tester

Code:

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Columns("A:C")) Is Nothing Then
            If Target = UCase("pomme") Or Target = LCase("POMME") Then Range("B" & Target.Row & ":C" & Target.Row).Interior.Color = vbRed
        End If
End Sub

22/12/2020, 10h37
Beehappy
Monsieur Bennasr ,
Thank you for your feed-back. Je vais tester tout de suite votre code.
Meanwhile , j'avais essayé celui ci-dessous, ça a marché mais le problème est que rouge se répète dans toutes les cellules de la ligne. Comment je peux y remédier pour l'avoir que dans 2 cellules ?
Code:

1 2 3 4 5 Private Sub Worksheet_Change(ByVal Target As Range) If Target = "Pomme" Then Target.Offset(0, 1).Value = "Rouge" Exit Sub End sub
22/12/2020, 10h43
Beehappy

Il se peut que je n'ai pas bien décrit le problème au début, je veux qu'elle affiche le mot "Rouge" pas la couleur !
22/12/2020, 10h44
BENNASR

c'est ce que tu cherches ?

Code:

If Target.Text = "Pomme" Then Range(Cells(Target.Row, 2), Cells(Target.Row, 3)) = "Rouge"

mon code modifié

Code:

1
2
3
4
 If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Columns("A:C")) Is Nothing Then
            If Target = UCase("pomme") Or Target = LCase("POMME") Then Range("B" & Target.Row & ":C" & Target.Row).Value = "rouge"
        End If

Code:

1 2 3 4 If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Columns("A:C")) Is Nothing Then If Target = UCase("pomme") Or Target = LCase("POMME") Then Range("B" & Target.Row & ":C" & Target.Row).Value = "rouge" End If
J'aimerai bien utiliser votre code je l'ai testé avec "pomme" et "rouge" ça marche bien, mais pourquoi quand j'utilise un mot avec un accent le code ne marche plus .
Je m'explique si je mets dans A1 : "Pas de réunion" et je veux afficher dans B1 et C1 "Pas de réunion", rien ne se passe !!
Est ce que les accents ou l'espace créent des problèmes ?

chez moi ça fonctionne

Code:

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Columns("A:C")) Is Nothing Then
            If Target = "Pas de réunion" Then Range("B" & Target.Row & ":C" & Target.Row).Value = "Pas de réunion"
        End If
End Sub

Salut.

Tant qu'à apprendre, essaie d'éviter les Exit Sub:

Code:

1
2
3
4
5
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Columns("A")) Is Nothing And Target.Count = 1 Then
      If Target.Value = "Pas de réunion" Then Target(1, 2).Resize(1, 2).Value = "Pas de réunion"
  End If
End Sub

22/12/2020, 11h09
Philippe Tulliez

Bonjour Bennasr,
Je me permet de signaler que cette instruction If Target = UCase("pomme") Or Target = LCase("POMME") Then ... peut se résumer à

Code:

If LCase(Target.Value) = "pomme" Then ...

Une autre instruction pour comparer deux chaînes quelque soit la casse

Code:

If StrComp(Target.Value, "Pomme", vbTextCompare) = 0 Then ...

Merci BENNASR, Pierre Fauconnier et Philippe Tulliez .
Code:

1 2 3 4 5 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns("A")) Is Nothing And Target.Count = 1 Then If Target.Value = "Pas de réunion" Then Target(1, 2).Resize(1, 2).Value = "Pas de réunion" End If End Sub
Ce code est bien mais pourquoi en l'exécutant j'ai une erreur d'éxecution 13 avec le débogage le surlignage est sur cette formule

Code:

If Target.Value = "Non" Then Target.Offset(0, 2).ClearContents

J'ai remplacé

Code:

If Target.Value = "Non" Then Target.Offset(0, 2).ClearContents

Par
Code:

1 2 3 If Not Intersect(Target, Columns("A")) Is Nothing And Target.Count = 1 Then If Target.Value = "Non" Then Target(1, 2).Resize(1, 2).ClearContents End If
Et ça marche à merveilles, merci les développeurs. C'est résolu