Modification de la valeur d'une cellule si termes absents d'une autre

Ma fille vient de rentrer, c'est comme si un ouragan s'installait dans mon bureau... je vous tiens au courant de mes avancées!

Bon! Alors,

J'ai essayé de remplacé Whole par Part dans la macro de notre shérif de l'espace, et rien ne change pour son fonctionnement, je me retrouve avec le même défaut qu'il avait détecté précédemment.

Pour que ce soit encore plus plus clair, vous trouverez un petit fichier exemple tout simple pour que vous vous voyez ce dont j'ai besoin.

Je ne vous mets pas le fichier que j'ai besoin de modifier car ce serait vraiment illisible.

Si au moins un des termes presents dans le premier feuillet se retrouve dans la cellule (A,i) du feuillet 2, (B,i) reste inchangé, si il n'y en a aucun, on le change.

Mais bon, s'il faut passer de 4 termes à tester à 25, et de 5 lignes de 100 caractères, à 5000 de 5000, je ne pense pas que l'adaptation posera de problème!

Merci encore!

Et pour les pros : ils ont peut-être senti le traquenard

Bon, j'ai essayé de replancher dessus aujourd'hui, plein de pistes mais rien de vraiment concluant...

Le seul truc qui marche, c'est le truc long et moche... Et vu le fichier à tester/modifier ce sera trèèèès long et trèèèès moche.

For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
    If Not Cells(i, 1) Like "*avion*" And Not Cells(i, 1) Like "*catamaran*" And Not Cells(i, 1) Like "*bateau*" And Not Cells(i, 1) Like "*montgolfière*" Then
        Cells(i, 4).Value = Cells(i, 2).Value & " et c'est génial"
    Else: Cells(i, 4).Value = Cells(i, 2).Value
    End If
Next

Toujours pas de pro dans le coin ?

Bonjour,

Une proposition, adaptée de celle de @xorsankukai :

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim f2 As Worksheet, f1 As Worksheet, Resultat As Range, i As Long, n As Long

Set f2 = Sheets("Feuil2")
Set f1 = Sheets("Feuil1")

For i = 1 To f2.Range("A" & Rows.Count).End(xlUp).Row
    For n = 1 To f1.Range("A" & Rows.Count).End(xlUp).Row
        Set Resultat = f2.Range("A" & i).Find(f1.Range("A" & n), lookat:=xlPart)
        If Not Resultat Is Nothing Then Exit For
    Next n
    If Not Resultat Is Nothing Then
        f2.Range("C" & i) = f2.Range("B" & i)
    Else
        f2.Range("C" & i) = f2.Range("B" & i) & " et c'est génial !"
    End If
Next i

End Sub

Bonjour Scarwild, le forum,

tu a écrit :

Toujours pas de pro dans le coin ?

ben en fait, comme il manque à ton pseudo un O au début et un E à la fin, j'attendais qu't'aies réglé ton complexe d'Œdipe pour intervenir (mais c'est toujours pas venu ) ; bon allez, j'vais quand même essayer d't'aider :

voici ton fichier modifié :

Ctrl e ➯ travail effectué !

Alt F11 pour voir le code VBA, puis revenir sur Excel

si besoin, tu peux demander une adaptation.

merci de me dire si ça te convient.

tu a écrit :

Et pour les pros : ils ont peut-être senti le traquenard

attention à ce traquenard : « qui vole un Œuf vole un bŒuf »

"2 images-bonus"

dhany

désolé, j'ai oublié les filles ! (elles risquent d'être jalouses, si elles ont pas leur image-bonus !)

car elles aussi (hélas) sont concernées par le complexe d'Œdipe :

"3 images-bonus réunies en une seule"

⚠ les images ci-dessus sont strictement réservées aux filles !

de plus, leur caractère choquant peut heurter la sensibilité des plus jeunes !

NDLR : L'auteur de ce message se dégage de toute responsabilité en cas d'infarctus ; de plus, il prie les femmes adultes de bien vouloir l'excuser d'avoir ravivé de mauvais souvenirs d'enfance (j'y peux rien, hein, moi, si les filles aussi sont concernées par ce fléau ! c'est pas ma faute, mais j'crois qu'c'est celle de Cupidon : j'crois bien qu'c'est lui qui décoche ce genre de flèches-là aussi !)

(oui, bon, j'ai compris !)

Salut Scarwild,

Salut l'équipe,

si j'ai bien compris...

Un double-clic en 'EXTRACT' démarre la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract
'
Cancel = True
With Worksheets("DATA")
    tData = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
End With
With Worksheets("EXTRACT")
    tExtract = .Range("A1:C" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    For x = 1 To UBound(tExtract, 1)
        iOK = 0
        tExtract(x, 3) = ""
        For Z = 1 To UBound(tData, 1)
            If InStr(tExtract(x, 1), tData(Z, 1)) > 0 Then
                iOK = 1
                Exit For
            End If
        Next
        If iOK = 0 Then tExtract(x, 3) = "Génial"
    Next
    .Range("A1").Resize(UBound(tExtract, 1), 3).Value = tExtract
End With
'
End Sub

A+

Bonjour à toutes et tous,

Je vous prie de m'excuser pour ma longue veille, mais le départ à la maternité le 11 aout, et la niassance de mon deuxième enfant le 12 a relégué ce problème excel aux oubliettes quelques semaines durant.

Pour ma part j'avais trouvé une solution de mon côté, mais n'ai pas eu le loisir de la partager avec vous :

Private Sub CommandButton2_Click()

Dim j As Integer
    For j = 1 To 4
        For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
            If (InStr(Cells(i, 1).Value, Worksheets("Feuil1").Cells(j, 1).Value) > 0) Then
                Cells(i, 4).Value = Cells(i, 2).Value
            End If
            If (InStr(Cells(i, 4).Value, "") = 0) Then
                Cells(i, 4).Value = Cells(i, 2).Value & " et c'est génial"
            End If
        Next
    Next

End Sub

Merci infiniment pour toutes vos contributions, et désolé encore d'avoir mis le temps à vous répondre : nullement un manque de considération, mais plutôt un submergement soudain et de grande ampleur! Maintenant je vais pouvoir lire attentivement et à tête reposée toutes vos propositions ainsi qu'élargir mes options grâce à vous toutes et tous! Merci encore!

Salut Scarwild,

félicitations!

A+

Alors après étude de vos travaux, le plus pratique à utiliser et moduler pour ce que je veux en faire, et bien mieux conçu que le mien qui a trop de limitations, est celui de Pedro22.

Merci encore à toutes et à tous et à une prochaine fois!

Scarwild.