VBA rechercher chaîne caractères

[C@thy]

Bonjour le forum,

oilà, je me pose une 'tite question juste avant de partir pour un long ouik-end :

je voudrais rechercher (pour les supprimer) toutes les ligne dont la colonne obervations (D) contient "suppr" (ex. : suppression, à supprimer etc...)

y a-t-il un autre moyen que Cells.Find(What:="suppr" etc....?
pas l'idéal dans une boucle sur toute la colonne

Merci pour votre aide et bon 14 juillet!!!

C@thy

 

[Yeahou]

Bonjour C@thy, le forum

va voir ce lien, cela devrait t'aller avec un minimum d'adaptation.

<http://www.excel-downloads.com/html/French/forum/read.php?f=1&i=101553&t=98318>

Cordialement, A+

 

[Abel]

Bonjour,

Oulà !

Donner un truc à C@thy ...

Bon aller, je m'lance !

Sub suppr()
Set plage = Range(Cells(2, 4), Cells(65536, ActiveCell.Column).End(xlUp))
For Each c In plage
If UCase(c.Value) = "SUPPR" Then c.EntireRow.Delete
Next
End Sub

En admettant que les valeurs de la colonne "D" commencent à la ligne 2.


Abel.

 

[Abel]

Tous,

Tient, c'est vrai ça !

Pourquoi réinventer l'eau chaude à chaque fois ?

A+

Abel

 

[C@thy]

Merci Yeahou et Abel pour votre réponse, mais mon problème c'est que la
cellule n'est pas égale à suppr mais contient suppr au milieu d'un texte.

C@thy

 

[Michel_M]

salut cathy, abel, yeahou

Cathy

peut être put tu encadrer suppr avec les symboles *
"*suppr*"

Bon WE à rallonge
Michel

 

[Abel]

C@thy, tous,

Bon, y a ça mais il y a pb s'il trouve plusieurs "suppr" à la suite.
Il faut relancer, donc pas terrible.

Sub suppr()
Set plage = Range(Cells(2, 4), Cells(65536, ActiveCell.Column).End(xlUp))
For Each c In plage
If Not c.Find("suppr") Is Nothing Then Rows(c.Row).Delete
Next
End Sub


C'est assez rapide. Je viens de le faire sur un tableau de 250 lignes en moins d'une seconde.
Reste plus qu'à réaffecter quelque chose à l'objet "c" qui vient d'être supprimer pour pouvoir le retester (cas des "suppr" qui se suivent).

Abel

 

[myDearFriend]

Bonjour Cathy, Yeahou, Abel et Michel_M


Pour ma part, je te propose ça :

Sub suppr()
Dim TabTemp As Variant
Dim L As Long, i As Long
Dim Flag As Boolean
'Charge les données dans un tableau variant temporaire (pour accélerer la macro)
With ActiveSheet
L = .Range("D65536").End(xlUp).Row
TabTemp = .Range(.Cells(1, 4), .Cells(L, 4)).Value
Selection.Clear
For i = 1 To L
If TabTemp(i, 1) Like "*suppr*" Then
If Not Flag Then
.Cells(i, 1).Select
Flag = True
End If
Union(Selection, .Rows(i).EntireRow).Select
End If
Next i
End With
If MsgBox("Confirmez-vous la suppression ?", vbYesNo) = vbYes Then
Selection.Delete
End If
End Sub


Michel_M a raison, les "*" associés à l'opérateur "Like" paraissent tout adaptés au problème.


Cordialement,
Didier_mDF

 

[myDearFriend]

Re- tout le monde,

Oups,

Heu.... la ligne "Selection.clear" n'a rien à voir là-dedans, il faut la supprimer !



Cordialement,
Didier_mDF

 

[michel]

bonsoir C@thy , Yeahou , Abel et Michel

la methode proposée par Didier dans le lien ci dessous devrait aussi t'interesser

Lien supprimé


bonne soirée
MichelXld

 

[michel]

bonsoir Didier

oouuppss...je suis un peu en retard ... et en plus je parlais de toi ...;o)


bonne soiree à toi
MichelXld

 

[Abel]

C@thy, Michel, myDearFriend, tous,

Je vois qu'il y a déjà des solutions.

Je vais éplucher ta solution Didier.

Et comme je ne voulais pas rester sur ma fin :

Sub suppr()
Set plage = Range(Cells(2, 4), Cells(65536, ActiveCell.Column).End(xlUp))
For Each c In plage
ligne = c.Row
While Not plage(ligne - 1).Find("suppr") Is Nothing
Rows(ligne).Delete
Wend
Next
End Sub

Ca fonctionne. 350 lignes en 2 secondes.
Comme l'a fait Didier, on peut rajouter la demande d'autorisation de suppression.


Bon ouikainedeu.

Abel

 

[FDI]

Bonsoir,

pour savoir si la cellule contient "suppr", je propose la fonction instr

exemple :

For Each c In Selection.Cells
If InStr(1, c.Value, "suppr", vbTextCompare) Then
Rows(c.Row).Delete
End If

Next c

 

[PhiBou]

Bonjour le Fil, le Forum

Une petite variante avec du While.

A noter que lorsqu'on efface une ligne dans une boucle
il faut décrémenter le compteur sinon on n'analyse pas la ligne suivante.

Sub SupprCathy()
Application.ScreenUpdating = False
Dim c As Long
Dim Fin As Long
Fin = Range("D65536").End(xlUp).Row
c = 1
Do While c < Fin + 1
If InStr(1, UCase(Cells(c, 4)), "SUPPR") Then
Cells(c, 4).EntireRow.Delete
Fin = Fin - 1
Else
c = c + 1
End If
Loop
Application.ScreenUpdating = True
End Sub

Bon défilé

PhiBou

 

[yeahou]

Bonjour tout le monde

toujours mon petit code de suppression de lignes adapté au cas de cathy simplement en changeant le test et au minimum deux fois plus rapide que l'utilisation d'un find ou d'une boucle standard.

Pour Phibou
au lieu de InStr(1, UCase(Cells(c, 4)), "SUPPR")
fait plutôt InStr(1, Cells(c, 4)), "SUPPR", 1), il y a une opération de moins et sur 65536 cellules, cela compte.

Cordialement, A+

Sub Supprimer_Lignes()

'définition des variables
Dim Tab_Cells As Variant, Tab_Row() As String, Mem_Row As Long
Dim Cellule_Debut As Range, Cellule_Fin
Dim Deb_Tab As Long, Compteur As Long, Compteur2 As Long, Compteur3 As Long

'désactivation de l'affichage écran pour gagner en rapidité
Application.ScreenUpdating = False

With ActiveSheet
'indiquer ici la plage de test
'si je désire tester les cellules colonnes A et D sur 6000 lignes la plage sera range("A16000")
'la ligne suivante définit le début du tableau de valeurs pour test
Set Cellule_Debut = .Range("D1")
'la ligne suivante définit la fin du tableau de valeurs pour test
'la valeur actuelle correspond à la dernière cellule de la colonne D avec possibilité de valeur
Set Cellule_Fin = Range("D" & Range("A1").SpecialCells(xlCellTypeLastCell).Row)
'mémorise la ligne de début du tableau de valeurs
Mem_Row = Cellule_Debut.Row - 1
'passe les valeurs de cellules au tableau de valeurs
Tab_Cells = .Range(Cellule_Debut.Address & ":" & Cellule_Fin.Address).Value
'initialise les compteurs
Compteur = 0
Compteur3 = 65536
'boucle sur la longueur du tableau
For Compteur2 = LBound(Tab_Cells) To UBound(Tab_Cells)
'indiquer ici la valeur du test et les ou la colonne du tableau, ici 1 car colonnes de test sur D uniquement
If InStr(1, Tab_Cells(Compteur2, 1), "SUPPR", 1) Then
If Compteur3 < 65536 Then
'indiquer ici les colonnes ou les lignes seront à supprimer, laisser de A à IV pour lignes entières
Tab_Row(Compteur) = "A" & (Compteur3 + Mem_Row) & ":" & "IV" & (Compteur2 + Mem_Row)
Else
'si première ligne en test ok ou ligne d'avant en test no ok, on incrémentre compteur
Compteur = Compteur + 1
'on redimensionne en conservant les valeurs
ReDim Preserve Tab_Row(1 To Compteur) As String
'indiquer ici la plage à supprimer, laisser de A à IV pour lignes entières
Tab_Row(Compteur) = "A" & (Compteur2 + Mem_Row) & ":" & "IV" & (Compteur2 + Mem_Row)
'on enregistre le numéro de première ligne test ok
Compteur3 = Compteur2
End If
Else
Compteur3 = 65536
End If
Next Compteur2
'on efface les lignes détectées en partant de la fin
For Compteur2 = Compteur To 1 Step -1

'pour test
'Application.ScreenUpdating = True
'.Range(Tab_Row(Compteur2)).Select
'MsgBox Tab_Row(Compteur2)

.Range(Tab_Row(Compteur2)).Delete Shift:=xlUp
Next Compteur2
.Range("A1").Select
End With
MsgBox "fini"
End Sub