Recherche d'un texte et suppression de presque toutes les lignes au dessus

Version imprimable

06/12/2018, 17h14
Sarmat31

Recherche d'un texte et suppression de presque toutes les lignes au dessus

Bonjour la communauté :zoubi:,

Je cherche à automatiser via mon code VBA, lors d'une intégration d'un onglet dans un fichier, la recherche dans la 1ere colonne du texte XXX, et une fois trouver il faut supprimer les lignes du dessus moins 1. Pour essayée d'être claire quand j'importe mon onglet le texte XXX peut se trouver sur la 15eme, la 18eme voire une autre ligne. Je cherche un code me permettant donc d'effacer les lignes (qui ne me sont pas utile) au dessus de celle où XXX se trouve sauf la ligne juste au dessus, la 14ème ou la 17eme soit ligneXXX-1 dans les cas cités ci avant.
Auriez vous quelques idées et solutions ?
D'avance merci ;).
06/12/2018, 17h19
MarcelG

Bonsoir Sarmat,

As-tu au moins un début de code à soumettre?
07/12/2018, 08h38
Sarmat31
Bonjour MarcelG,
Alors oui j'ai un code (qui ne fonctionne pas) car il me supprime toute les lignes qui ne contiennent pas "XXX".
Le voici (soyez gentil je débute) :
Code:

1 2 3 4 5 6 7 8 Private Sub commandbutton1_click() Dim i% For i = 2000 To 1 Step -1 If Cells(i, 1).Value <> "XXX" Then Rows(i).EntireRow.Delete Next i end sub
Je souhaiterai qu'il s'arrête à la première ligne où il trouve ce texte à minima et encore mieux juste à la ligne avant.
07/12/2018, 08h55
MarcelG

Bonjour Sarmat,

Citation:

Le voici (soyez gentil je débute) :

Ne t'inquiète pas, nous passons tous par ce stade.

Au demeurant, merci de baliser le code retourné par les bornes #.

La méthode Find explicitée ici retourne un objet Range.
Il suffit alors de supprimer les lignes depuis la ligne de cet objet - 1 jusqu'à celle de départ en reculant d'une occurrence.

Tu traduis ce paragraphe en VBA et tu n'hésites pas à revenir.

J'ai aussi essayé ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub commandbutton1_click()
Dim i As Integer
 With ThisWorkbook.Sheets("Feuil1")
'Précisez le nom de votre feuille
            For i = .Range("A" & .Rows.Count).End(xlUp).Row To 1 Step -1
'je travaille sur la colonne a
 'Rows.count permet de retourner le nombre de ligne de la plage range
                        If .Range("a" & i).Value <> "XXX" Then
                                   .Rows(i).Delete
                        End If
            Next i
 End With
 End Sub

Là il supprime aussi tout !

Citation:

Envoyé par Sarmat31

Bonjour la communauté :zoubi:,

Je cherche à automatiser via mon code VBA, lors d'une intégration d'un onglet dans un fichier, la recherche dans la 1ere colonne du texte XXX, et une fois trouver il faut supprimer les lignes du dessus moins 1. Pour essayée d'être claire quand j'importe mon onglet le texte XXX peut se trouver sur la 15eme, la 18eme voire une autre ligne. Je cherche un code me permettant donc d'effacer les lignes (qui ne me sont pas utile) au dessus de celle où XXX se trouve sauf la ligne juste au dessus, la 14ème ou la 17eme soit ligneXXX-1 dans les cas cités ci avant.
Auriez vous quelques idées et solutions ?
D'avance merci ;).

Bonjour
somme toute si j'ai bien compris ton exposé
on supprime les lignes au dessus de "XXX" a partire de l'offset(-1) de "XXX"
Code:

1 2 3 4 5 6 7 Sub test() with activesheet Set plage = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)) Set c = plage.Find("XXX", lookat:=xlWhole) If Not c Is Nothing Then .Range("A1", c.Offset(-1)).EntireRow.Delete end with End Sub
il te sera tres facile d'en faire une fonction generique a fin de l'avoir a dispo pour autre chose que "XXX"
;)
edit:
c'etait -2 :oops:
avec un interface avec un inputbox en restant une sub
Code:

1 2 3 4 5 6 7 8 9 Sub delete_row_before_shearch() Dim chaine, c As Range chaine = InputBox("tapez l'object de votre recherche", "recherche d'expression") If chaine <> "" Then Set plage = Range("A1", Cells(Rows.Count, 1).End(xlUp)) Set c = plage.Find(chaine, lookat:=xlWhole) If Not c Is Nothing Then Range("A1", c.Offset(-2)).EntireRow.Delete End If End Sub

07/12/2018, 10h38
MarcelG

Salut Patrick,

Excuse-moi mais je ne vois pas en quoi ta procédure diffère de la mienne.
Juste un détail:
En fin de procédure, je libère les variables affectées à des objets.

Merci à vous 2,

donc au final mon code qui fonctionne exactement comme je voulais :mouarf: est celui-ci
Code:

1 2 3 4 5 6 7 8 Dim chaine, c As Range Dim plage chaine = ("XXX") If chaine <> "" Then Set plage = Range("A1", Cells(Rows.Count, 1).End(xlUp)) Set c = plage.Find(chaine, lookat:=xlWhole) If Not c Is Nothing Then Range("A1", c.Offset(-2)).EntireRow.Delete End If
j'ai supprimé l'inputbox dont je n'avais pas besoin.
Encore MERCI.

07/12/2018, 11h06
MarcelG
Salut,

Plusieurs remarques.
1 - On ne saurait trop conseiller de déclarer des variables autrement qu'en Variant.
Dans 99% des cas, la précision de cette déclaration peut servir à la saisie du code.
(Au passage, ceci est vrai pour les dictionnaires trop souvent déclarés en Variant)

2 -
Code:

1 2 chaine = ("XXX") If chaine <> "" Then
Là, :cfou:

3 - Autre conseil, rattacher les objets Range permet de clarifier le code. Pour ce faire, le bloc With peut être utile.

4 - Il est d'usage de baliser tout code reporté par les bornes #.
10/12/2018, 08h23
Sarmat31

MarcelG,
Ok pour le point 4 j'ai compris.
Le point 2 en effet :ptdr: en l'écrivant je me suis dit qu'il y avait un loup mais ça à fonctionné et je ne sais pas pourquoi du coup !
Le point 3 je vais chercher dans ce sens.
En revanche ton point 1 ? pas compris !
En tout cas merci de prendre le temps de répondre et d'aiguiller les novices !
10/12/2018, 09h22
MarcelG

Bonjour Sarmat, Bonjour le Forum,

Déclarer une variable en variant, c'est à dire sans précision aucune, peut entrainer des erreurs (méthode non gérée par cet objet...).
En préciser la nature permet de mieux maitriser le code et d'avoir accès aux méthodes et propriétés plus facilement lors de la saisie (dès le "." de rattachement informé).

Tutoriel à consulter: les variables par Silkyroad.

Bonne continuation.

Re bonjour j'aurai une autre question qui serait du coup l'inverse de la première.
Je m'explique, je cherche une chaine de caractère "XXX", je me place 2 cellules au dessus et j'insère des lignes jusqu'à ce ma chaine de caractères se retrouve sur la 25ème ligne.
Je ne suis pas loin d'y arriver mais il me manque un petit peu...
J'arrive à trouver ma chaine de caractère, me placer 2 cellules au dessus et j'y insère 1 ligne.
Tout cela avec ce code :
Code:

1 2 3 4 5 6 'Insertion de lignes avant la chaine de caractère "XXX" pour que celle-ci soit positionnée sur la 25ème ligne. Dim x As Range Set x = Cells.Find("XXX", , xlValues, xlPart, , , False) If Not x Is Nothing Then x.Offset(-2, 0).Select Selection.EntireRow.Insert
Je ne sais pas comment rajouter des lignes jusqu'à ce que ma chaine de caractère se retrouve sur la 25ème ligne !!!
Auriez-vous une idée de la suite à donner pour y arriver ?

Encore merci.

Bonjour Sarmat,

Sur ton code.
1 - Comme stipulé un grand nombre de fois sur le Forum, ôte ces f... Select qui ne servent à rien.
Si tu utilises l'enregistreur de macro (parfois utile), alors il te le faut purger.
2 - Pour clarifier le code et par sécurité, attache chaque objet Range à la feuille à laquelle il appartient.

Tu adaptes
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Option Explicit Sub Insert() Dim t As Range With Worksheets(1) Set t = .Range("A2:A250").Find("zz", lookat:=xlWhole, LookIn:=xlValues) .Rows("1:" & 25 - t.Row).Insert Shift:=xlDown Set t = Nothing End With End Sub

Re bonjour c'est encore moi, :mrgreen:

voila toujours sur le même thème j'ai écrit ça :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Worksheets("feuil1").Cells.ClearContents ' Efface le contenu de la feuille qui va recevoir les données Worksheets("feuil2").Activate Dim t As Range With Worksheets("feuil2") Set t = Range("a:a").Find("XXX", lookat:=xlWhole, LookIn:=xlValues) Rows("1:" & 2 - t.Row).Select Selection.Copy Worksheets("feuil1").Range("A2").Select.PasteSpecial Paste:=xlPasteAll Set t = Nothing End With Application.DisplayAlerts = False Worksheets("feuil2").Delete Application.DisplayAlerts = True end sub
Ce que je souhaitez faire toujours pareil trouver mon XXX dans ma 1ère colonne, copier tout ce qui est au dessus de la ligne trouver -2, et le coller sur ma feuil1.
Mais ça fonctionne pas.
Avez-vous des idées de corrections pour que ça fonctionne ?

Merki encore :lol:

19/12/2018, 12h04
MarcelG

Bonjour Sarmat,

Citation:

Mais ça fonctionne pas.

Quel message d'erreur sur quelle ligne surlignée généralement en jaune.

Désolé mais tu ne tiens pas compte des indications qui te sont adressées (Select, rattachement Range)

Pose toi la question de savoir la valeur de 2-t.Row.

Bonjour
en 2019 office a prevu une mise a jour qui erazera le fichier complet a chaque fois que selct sera utilisé (a bon entendeur)

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub test()
    Worksheets("feuil1").Cells.ClearContents    ' Efface le contenu de la feuille qui va recevoir les données
    Dim t As Range
    With Worksheets("feuil2")
        Set t = .Range("a:a").Find("XXX", lookat:=xlWhole, LookIn:=xlValues)
        If Not t Is Nothing Then
            .Rows("1:" & t.Row - 2).Copy Destination:=Worksheets("feuil1").Range("A2")
        End If
        Set t = Nothing
    End With
End Sub

;)
ou alors histoire de bien remuer les neuronnes on prends le cheval par la queue

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub test2()
    Dim t As Range
    Set t = Worksheets("feuil2").Range("a:a").Find("XXX", lookat:=xlWhole, LookIn:=xlValues)
    If Not t Is Nothing Then
        With Worksheets("feuil1")
            .Cells.ClearContents
            t.Parent.Range("A1").Resize(t.Row - 2, Columns.Count).Copy Destination:=Worksheets("feuil1").Range("A2")
        End With
    End If
    Set t = Nothing
End Sub

19/12/2018, 12h24
MarcelG

Salut,

Le code de Patrick, que je salue au passage, ne t'empêche pas de répondre aux questions que je t'ai posées.
Ces réponses te serviront à la compréhension de ce code.

Patrick,

Citation:

en 2019 office a prevu une mise a jour qui erazera le fichier complet a chaque fois que selct sera utilisé (a bon entendeur

Plus précisément?
20/12/2018, 00h21
patricktoulon

re

re
Marcel c'etait une blague tu imagine sinon :ptdr: a chaque fois qu'il y a select le fichier effacé :ptdr: