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

**Sarmat31** · 06/12/2018, 17h14

Bonjour la communauté

,

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

.

**MarcelG** · 06/12/2018, 17h19

Bonsoir Sarmat,

As-tu au moins un début de code à soumettre?

**Sarmat31** · 07/12/2018, 08h38

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 :

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

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.

**MarcelG** · 07/12/2018, 08h55

Bonjour Sarmat,

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.

**Sarmat31** · 07/12/2018, 08h55

J'ai aussi essayé ça :

Code :

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

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 !

**patricktoulon** · 07/12/2018, 09h32

Envoyé par Sarmat31

Bonjour la communauté

,

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 :

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

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

avec un interface avec un inputbox en restant une sub

Code :

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

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

**MarcelG** · 07/12/2018, 10h38

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.

**Sarmat31** · 07/12/2018, 10h50

Merci à vous 2,

donc au final mon code qui fonctionne exactement comme je voulais

est celui-ci

Code :

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

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.

**MarcelG** · 07/12/2018, 11h06

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 :

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

1
2
chaine = ("XXX")
 If chaine <> "" Then

Là,

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 #.

**Sarmat31** · 10/12/2018, 08h23

MarcelG,
Ok pour le point 4 j'ai compris.
Le point 2 en effet

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 !

**MarcelG** · 10/12/2018, 09h22

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.

**Sarmat31** · 11/12/2018, 09h44

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 :

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

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.

**MarcelG** · 11/12/2018, 10h10

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 :

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

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

**Sarmat31** · 19/12/2018, 11h51

Re bonjour c'est encore moi,

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

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
 
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

**MarcelG** · 19/12/2018, 12h04

Bonjour Sarmat,

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.

**patricktoulon** · 19/12/2018, 12h09

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 :

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

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 :

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

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

**MarcelG** · 19/12/2018, 12h24

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,

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?