Discussion :

[sab1458]

Bonjour à tous
J'ai besoin de votre aide

J'ai une liste de mots sur la feuille 1 : chien chat poule ours
Une liste de mots sur la feuille 2 : chien chat (poule et ours sont donc absents)
Et je souhaiterais que poule et ours soient remplacés par un x dans le feuille 1

Pouvez-vous m'aider ?

Je pense être clair !

Merci d'avance.

[unparia]

Bonjour
Il suffit de parcourir en boucle les cellules concernées de la Feuil1 et, pour chaque mot, appliquer WorksheetFunction.Countif (de ce mot, sur la feuille 2) ,. Si retourne 0, écrire "x"

[eric4459]

Bonjour Sab,
Est-ce que tu as un mot par cellule ou tous les mots sont-ils dans la même cellule?
Eric

[sab1458]

Bonjour à vous et merci pour vos réponses

unparia
Je suis vraiment bleue pour ce genre de chose
Peux-tu STP écrire un programme en entier.
Merci d'avance

Eric
J'ai un mot par cellule


et en plus je viens de voir que j'ai des espaces derrière les mots, y a t il moyen de dire que la cellule contient le mot et non qu'elle est égale ?
Merci d'avance

[unparia]

Peux-tu STP écrire un programme en entier.

Désolé, mais pas moi (contraire à mes principes, mais également à ton intérêt).
Je t'aiderai par contre assez volontiers à corriger au besoin le code que tu tenteras sur la base de ce que je t'ai indiqué.

y a t il moyen de dire que la cellule contient le mot et non qu'elle est égale ?

c'est ce que te permet de faire également WorksheetFunction.Countif, comme tu pourras le constater à la lecture de la rubrique "WorksheetFunction.CountIf, méthode" de ton aide VBA.

[eric4459]

SAB1458
Voici un exemple qui fonctionne, il y a surement mieux et/ou plus simple et je ne sais pas si il correspond exactement à ton besoin dans ce cas ,il pourra toujours t'inspirer.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub Enlever_Mots2()
Dim Src As Worksheet
Dim Dest As Worksheet
Dim Cel1 As Range
Dim Cel2 As Range
Dim NbCol1 As Integer
Dim NbCol2 As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Set Src = ThisWorkbook.Sheets("Sheet1")
Set Dest = ThisWorkbook.Sheets("Sheet2")
Set Cel1 = Src.Range("A1")
Set Cel2 = Dest.Range("A1")
i = 0
j = 0
 
With Src
NbCol1 = .Cells(1, Columns.Count).End(xlToLeft).Column  'on compte le nbre de col de la feuille 1 ensupposant que les mots sont uniquement sur la ligne 1
End With
 
Do While (i < NbCol1) 'On boucle à partir des valeurs de cellules sur la feuille 2
    If InStr(Cel2.Offset(0, j).Value, Cel1.Offset(0, i).Value) Then 'si les cellules ont la même valeur
        Cel1.Offset(1, i) = "Ok" ' on mets Ok dans la cellule du dessous
        j = j + 1 ' Si ok alors on passe au mot de la feuille2 suivant
        i = 0 'ici on remets i à 0 pour repartir sur le premier mot de la feuille 1
    Else
     i = i + 1 'si pas identique on reste sur le mot de la feuille 2 et on passe au mot suivant de la feuille 1
    End If
Loop
 
For k = 0 To NbCol1 ' ici on va verifier si il y a "Ok" dans la deucieme ligne de la feuille 1
    If Cel1.Offset(1, k) = "Ok" Then
        Cel1.Offset(1, k) = "" 'Si on trouve "Ok" on effece la valeur "Ok"
    Else
        Cel1.Offset(0, k) = "x" 'Si on ne trouve pas "Ok" alors on met "x" à la place du mot
    End If
Next k
End Sub

Eric

[patricktoulon]

re
Bonjour a tous

allons eric !!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub supmotnotdouble()
    mots = Array("chien", "chat", "poule", "ours")
    For i = 0 To UBound(mots)
        If Application.WorksheetFunction.CountIf(Sheets(2).Cells, mots(i)) = 0 Then
            sheets(1).Cells.Replace What:=mots(i), Replacement:="X", LookAt:=xlPart    'LookAt:=xlwhole pour le mot entier dans la cell 
        End If
    Next
End Sub

si tu veux faire ca dans une plage bien précise tu remplace "cells" par "range("blablax:blablaY")

le premier cells c'est la plage a parcourir dans le sheets 2 pour vérifier les présence
le 2 Emme c'est la plage du sheets(1) a appliquer les replacement


le soucis avec Xlpart c'est que le "replace" replace rien que le mots dans la chaine
du coup si on a "un ours" dans une cellule on obtient "un X" c'est balo hein!!!
si l'on utilise XlWhole la cellule "un ours" est carrément zappé c'est ballo hein!!!!

donc on triche un peu on ne met plus d'argument "XL..." mais on utilise les inconnus représenté par ce symbole("*") de la même manière qu'avec "LIKE"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Replace What:="*ours*", Replacement:="X"

et là la cellule "ours" ou "un ours" est bien replacer par un "X"

voila voila

[unparia]

Countif (relire ce que j'en ai dit plu haut) a tout ce qu'il faut tout seul.
Exemple bâclé (liste 1 en colonne A de Feuil1 et liste 2 en colonne A de Feuil2) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Dim lader As Long, c As Range
  lader = Worksheets("Feuil2").Range("A" & Rows.Count).Row
  For Each c In Worksheets("Feuil1").Columns(1).SpecialCells(xlCellTypeConstants)
  If WorksheetFunction.CountIf(Worksheets("Feuil2").Range("A1:A" & lader), c.Value & "*") = 0 Then
     c.Value = "x"
  End If

[eric4459]

Salut à tous,
J'ai vraiment besoin de vacances, je vais revoir mes bases ;-)
eric

[patricktoulon]

bonsoir unparia
avec un dico et le cells.replace on peut même diminuer le nombre de replace
et non countiff ne fait pas tout "tout seul"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub supmotnotdouble()
    dim c as range ,dico as object
Set dico = CreateObject("Scripting.dictionary")
    For Each c In Worksheets("Feuil1").Columns(1).SpecialCells(xlCellTypeConstants)
        If Not dico.exists(c.Value) Then
            If Application.WorksheetFunction.CountIf(Sheets(2).Cells, c.Value) = 0 Then
                Sheets(1).columns(1).Replace What:=c.value, Replacement:="*X*"
            End If
            dico(c.Value) = ""
        End If
    Next
End Sub

on pourrait même histoire encore d'accélérer ,boucler sur une variable tableau du sheets (1).column (1)

[jurassic pork]

hello,
si au lieu de remplacer les mots par X sur la première feuille , tu pouvais ne changer que le format des cellules (par exemple texte barré), tu pourrais employer un format conditionnel avec comme règle une formule du genre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=NB.SI(Feuil2!$A$1:$A$11;SUPPRESPACE(A1))=0

Ami calmant, J.P

[unparia]

Bonjour patricktoulon

et non countiff ne fait pas tout "tout seul"

il ne le fait pas si tu l'utilises comme tu le fais. Il le fait si tu l'utilises TRES EXACTEMENT comme je le fais.

Par "il le fait" et "il ne le fait pas", entendre : en conformité avec la demande, à savoir (pour mémoire) :

1)

J'ai une liste de mots sur la feuille 1 : chien chat poule ours
Une liste de mots sur la feuille 2 : chien chat (poule et ours sont donc absents)
Et je souhaiterais que poule et ours soient remplacés par un x dans le feuille 1

2)

J'ai un mot par cellule

3)

et en plus je viens de voir que j'ai des espaces derrière les mots

y a t il moyen de dire que la cellule contient le mot et non qu'elle est égale ?

J'ai interprété la précision 3) comme un seul espace éventuellement présent derrière chaque mot (et mon code remplit parfaitement ce "contrat"
Mais voilà la minuscule modif pour prendre en considération l'éventualité de plusieurs espaces :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Dim lader As Long, c As Range
  lader = Worksheets("Feuil2").Range("A" & Rows.Count).Row
  For Each c In Worksheets("Feuil1").Columns(1).SpecialCells(xlCellTypeConstants)
  If WorksheetFunction.CountIf(Worksheets("Feuil2").Range("A1:A" & lader), RTrim(c.Value) & "*") = 0 Then
     c.Value = "x"
  End If
Next

Je laisse le demandeur t'expliquer que ni ton 1er code, ni le second ne correspondent à ce qu'il souhaite.
Je reviendrai alors pour faire encore mieux, toujours avec Countif uniquement et éviter ainsi une maladresse ne résultant pas de mon code, mais de la décision que le demandeur a exprimé en 3)

[patricktoulon]

re
Bonsoir unparia
met une variable compteur dans ton if et dans la mienne tu comprendra tout seul

et il faut pas négligé que les jokers(*) sont non affirmatif
donc si j'ai
" unparia"
ou
"unparia "
ou
" unparia "
et que je cherche unparia je fait "*unparia*"
je gagne a tout les coups
en gros le joker dans cette situation veut dire
quelque chose ou rien
fait moi plaisir met la cette variable compteur

[unparia]

A patricktoulon : pourquoi veux-tu que je "compte" ce qui ne fait pas le boulot ?
Car ton code ne le fait pas, le boulot demandé. A partir de cette constatation, ma foi ...
Bon ... je n'ai pas l'intention d'entamer une polémique inutile. Attendons donc la réaction du demandeur, s'il tu le veux bien (ce sera bien plus sain).

[patricktoulon]

re
allez demo ca vaut bien mieux que des mots

regarde bien les deux démo des qu'un mots est présent plus de deux fois dans feuil1 on voit que ma méthode mouline moins
pour la simple et bonne raison c'est que ta méthode remplace une cell a la fois par mots * n occurrences
moi je remplace tout les identiques en une seul fois par mots absent

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub patrick()
    Dim c As Range, dico As Object
Set dico = CreateObject("Scripting.dictionary")
    i = 0
    For Each c In Worksheets("Feuil1").Columns(3).SpecialCells(xlCellTypeConstants)
        If Not dico.exists(c.Value) Then
            If Application.WorksheetFunction.CountIf(Sheets(2).Cells, c.Value) = 0 Then
                 i = i + 1: Sheets(1).Columns(3).Replace What:=c.Value, Replacement:="X"
            End If
           dico(c.Value) = ""
        End If
    Next
Cells(1, 4) = i & " replacement global"
End Sub
 
Sub unparia()
Dim lader As Long, c As Range
  lader = Worksheets("Feuil2").Range("A" & Rows.Count).Row
  i = 0
  For Each c In Worksheets("Feuil1").Columns(1).SpecialCells(xlCellTypeConstants)
  If WorksheetFunction.CountIf(Worksheets("Feuil2").Range("A1:A" & lader), c.Value & "*") = 0 Then
     i = i + 1: c.Value = "x"
  End If
Next
Cells(1, 2) = i & " replacement simple "
End Sub

avec moins de différences

[unparia]

A patricktoulon
Tu devrais prendre le temps de tout relire, notamment en ce qui concerne les espaces éventuellement présents ici et/ou là en fin de chaîne :
Mets donc "chat" en feuil1 et "chat " (avec un espace, donc en feuil2 et lance ton code et regarde !
(entre autres ...)
Une fois de plus. Attendons s'il te plait la réaction du demandeur.

[patricktoulon]

Bonjour Unparia

oui en effet tu a raison
en voici une qui match a tout les coups avec des espace ou non dans la feuille 1 et inversement
et toujours 1 seul replace pour toutes les occurrences VS ta version qui replace le mot 1 fois * occurrences
on sort un peu des sentiers battus
le principe est simple
faire une chaine avec le tableau des mots dans feuil2 et tester avec like +joker la feuil1 toujours avec le dico
regarde la chaine dans le debug

et encore je ne suis pas sur que le dico soit utile a moins que l'énoncé de la boucle mémorise la plage de départ / j'ai pas testé ce point ( a vérifier) au quel cas on fait Peter le dico

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub patrick2()
    Dim c As Range, dico As Object, t
    Set dico = CreateObject("Scripting.dictionary")
    With Sheets(2): t = Join(Application.Transpose(.Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value), "|"): End With
    Debug.Print t
    For Each c In Worksheets("Feuil1").Columns(3).SpecialCells(xlCellTypeConstants)
        If Not dico.exists(c.Value) Then
            If Not t Like "*" & c.Value & "*" Then i = i + 1: Worksheets(1).Columns(3).Replace What:=c.Value, Replacement:="X"
             dico(c.Value) = ""
        End If
    Next
    Cells(1, 4) = i & " replacement global"
End Sub

EDIT OUI CEST BIEN CA
Histoire de reduire le code et l'utilisation mémoire on fait peter le dico

remplacer la ligne "if not ...."
par celle ci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not t Like "*" & c.Value & "*" And Not c Like "X" Then i = i + 1: Worksheets(1).Columns(3).Replace What:=c.Value, Replacement:="X"

et faire sauter la ligne 4,8,10,11
ca m'a permis aussi de voir qu'avec le dico j'avais 6 replace global et maintenant 5
en effet dans le dico il faut mettre trim(c.value)
voila voila
j'adore ce genre de truc

[Marc-L]

Bonjour, bonjour !

Avec le B-A-BA d'Excel - une simple formule de calculs - cela nécessite environ 5 lignes de code et ce,
sans boucle ni dictionnaire ni Replace ni le vélo de la grand-mère, juste une formule de calculs et c'est tout ‼

Voilà, voilà !

_________________________________________________________________________________________________________

Je suis Paris, Charlie, Bruxelles, …

[patricktoulon]

re
moi je peut le faire en zero ligne de code aussi
tu regarde simplement les feuilles

ensuite
des codes ont été présenté car il me semble que nous somme sur le forum VBA macro excel et non excel et ses formules
maintenant je suis curieux
je veux bien voir ces 5 lignes de code sans boucle
bien que c'elle de unparia et moi le font déjà en enlevant le msgbox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub patrick2()
    Dim c As Range, t
    With Sheets(2): t = Join(Application.Transpose(.Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value), "|"): End With
    For Each c In Worksheets("Feuil1").Columns(3).SpecialCells(xlCellTypeConstants)
            If Not t Like "*" & c.Value & "*" And c <> "X" Then i = i + 1: Worksheets(1).Columns(3).Replace What:=c.Value, Replacement:="X"
     Next
    MsgBox i & " replacement global"
End Sub

[Marc-L]

Pour toi mon Patrick je peux même descendre en trois lignes de code (voir une car il n'y a qu'une seule affectation) !

J'ai bien évoqué un code VBA utilisant une formule de calculs …