XL 2016 Mettre 0 décalé de 20 cases après avoir trouvé un Texte

[Stéfane]

Sub Mettre_0_Cellule_20
Dim zone As Range
Dim der_ligne As Long
Dim I&
    Set zone = Range("C28").CurrentRegion
    der_ligne = zone.Rows(zone.Rows.Count).Row
        For I = der_ligne To 1 Step -1
            If Cells(I, 3).Text = "TEXT 1 " & "TEXT 2" Then
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''       
             Rows(I, 20).Select            C'est là que je bloque
             Selection.FormulaR1C1 = 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''             
            End If
        Next
End Sub

Avec cette macro, je souhaite mettre "0" dans la cellule qui se trouve 20 cellules vers la droite sur la même ligne, après la détection des mots ''TEXT 1'' et ''TEXT 2'' dans la colonne "C"
J'ajouterais d'autres mot par la suite, à rechercher, pour réaliser la même démarche.

Auriez-vous svp une solution pour compléter cette macro.

Merci pour votre aide

 

[Stéfane]

Merci Sylvanu, c'est bien ce que je cherche, juste si c'est possible au lieu de devoir écrire les mots, pour lesquels je souhaite mettre 0 en plage "AC" de la feuille, pouvoir les écrire directement dans la macro si cela est possible bien sur.

 

[sylvanu]

Re,

Ce que l'on conçoit bien s’énonce clairement, et les mots pour le dire arrivent aisément

En passant par un array qui donne la liste des mots :

Option Explicit: Option Base 1
Sub Mettre_0_Cellule_20()
    Dim Liste, Plage As Range, PL%, DL%, L%, I%, Mot$
    Effacer
    Liste = Array("TEXT 1", "TEXT 5", "TEXT 4", "TEXT 7")
    PL = Range("C1").End(xlDown).Row
    DL = Range("C65500").End(xlUp).Row
    Set Plage = Range(Cells(PL, "C"), Cells(DL, "C"))
    For L = 1 To UBound(Liste)
        Mot = Liste(L)
        If Mot <> "" Then
            For I = PL To DL
                If Cells(I, "C") Like "*" & Mot & "*" Then
                    Cells(I, 23) = 0
                End If
            Next I
        End If
    Next L
End Sub

 

[Stéfane]

Merci beaucoup pour votre aide Sylvanu!! c'est exactement cela que cherche.

Et merci à tous également pour votre aide.
Bonne nuit à tous.

 

[sylvanu]

Bien le bonjour,
Maintenant que ça marche, vous avez surement remarqué qu'il restait dans la macro des résidus de la macro précédente. Qui plus est, si la liste est longue on peut accélérer le processus par l'utilisation de deux arrays :

Sub Mettre_0_Cellule_20()
    Dim Liste, Plage As Range, PL%, DL%, L%, I%, Mot$, T_In, T_Out
    Application.ScreenUpdating = False                      ' Fige écran
    Liste = Array("TEXT 1", "TEXT 5", "TEXT 4", "TEXT 7")   ' Liste des mots à rechercher
    PL = Range("C1").End(xlDown).Row                        ' Première ligne
    DL = Range("C65500").End(xlUp).Row                      ' Dernière ligne
    T_In = Range(Cells(PL, "C"), Cells(DL, "C"))            ' Transfert dans array de la zone utile
    ReDim T_Out(UBound(T_In))                               ' T_Out array de sortie qui sera dans W
    For L = 1 To UBound(Liste)                              ' Pour tous les mots cherchés
        Mot = Liste(L)
        If Mot <> "" Then
            For I = 1 To UBound(T_In)                       ' Pour tous les mots de la liste
                If T_In(I, 1) Like "*" & Mot & "*" Then     ' Si contient le mot
                    T_Out(I) = 0                            ' 0 dans l'array de sortie
                End If
            Next I
        End If
    Next L
    Range("W" & PL).Resize(UBound(T_Out), 1).Value = Application.Transpose(T_Out)   ' Transfert array dans plage W
    Application.ScreenUpdating = True
End Sub

 

[Stéfane]

Bonjour Sylvanu,

Merci.
Effectivement cette nouvelle macro est beaucoup plus rapide!!, mais sur mon tableau elle décale l'inscription des 0 d'une ligne vers le bas.
Ma colonne cible pour ces 0 est V pas W, c'est peut-être cette modification qui engendre le problème, j'essais d'adapter mais pas trouvé pour le moment.

 

[sylvanu]

Re,
Fournissez donc un fichier représentatif.
Ca fait plusieurs fois qu'on vous le demande.
On en est à 35 post ce qui aurait pu être résolu en 10.

 

[Stéfane]

Voici ci joint un exemple plus précis de ma recherche.

Merci.

 

[sylvanu]

Re,
C'est quand même plus simple comme ça.
La feuille Référence est votre feuille d'origine pour détecter les erreurs.

 

[Stéfane]

Merci Sylvanu, cela fonctionne parfaitement !!

J'ai juste eu des difficultés et ai cherché un bon moment car étrangement une autre macro interférer avec la votre et l'empêchait de fonctionner normalement.
Merci beaucoup.

Vous m'aviez proposé au départ la macro ci-joint.
Est-elle adaptable a mon cas si je souhaite écrire des mots TEXT... dans la plage AA1 AA20 ?

Encore merci.

 

[sylvanu]

Désolé, pas compris.
Cette macro n'écrit jamais de mots, elle ne met que des 0 lorsqu'elle trouve une occurrence.
Quels sont les mots que vous voulez écrire en AA1:AA20 ? Dans quel ordre ?
Pouvez vous fournir un fichier représentatif de ce que vous voulez, avec de préférence l'attendu, comme votre dernière PJ.
J'ai l'impression de tourner en rond.

 

[Staple1600]

Bonjour

Question endimanchée
Est-ce que faire des boucles dans son VBE, c'est tourner en rond?

Moi je tourne pas en rond, mais je suis presque rond(*) à force de chercher à comprendre ce qu'il faut faire.

(*): j'ai cru que quelques gorgées d'alcool, boosteraient mes 1 048 576 neurones
(oui je sais c'est peu)

NB: C'était juste un petit message sur un ton badin pour saluer Sylvanu et sa persévérance

 

[Stéfane]

Désolé, pas compris.
Cette macro n'écrit jamais de mots, elle ne met que des 0 lorsqu'elle trouve une occurrence.
Quels sont les mots que vous voulez écrire en AA1:AA20 ? Dans quel ordre ?
Pouvez vous fournir un fichier représentatif de ce que vous voulez, avec de préférence l'attendu, comme votre dernière PJ.
J'ai l'impression de tourner en rond.

Voilà en PJ, c'est semblable à l'une des première solution proposée.
Désoler d'abuser .

Ps :Bonjour Staple1600, A ta santé....

 

[sylvanu]

Je rêve ou c'est bien exactement la solution proposée en post #30 ?
Vous auriez pu l'adapter vous même.
Donc, ma persévérance a pris fin. Je jette l'éponge.
43 posts pour ça, c'est désespérant.
En PJ la dernière version, vous avez tout pour continuer à adapter au gré de vos fantasmes.

 

[Stéfane]

Je rêve ou c'est bien exactement la solution proposée en post #30 ?
Vous auriez pu l'adapter vous même.
Donc, ma persévérance a pris fin. Je jette l'éponge.
43 posts pour ça, c'est désespérant.
En PJ la dernière version, vous avez tout pour continuer à adapter au gré de vos fantasmes.

Merci pout tout Sylvanu
Désolé d'avoir abusé.
Bonne après midi.

 

[sylvanu]

Par pitié, mettez en résolu la solution #44. ( voir Lien )
Le futur lecteur intéressé par le titre du post sera bien incapable dans ce fatras de trouver la solution proposée.