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

 

[C@thy]

Bonjour tout le monde!

Ouh là là, merci pour toutes ces réponses.

Je viens de tester les soluces de Abel et de SDI (parceque les plus courtes en instructions), ça fonctionne au poil. Je vais tester les autres et prendre la plus rapide en exécution.

Merci beaucoup à tous. J'ai passé un super ouik-end à Milan.

@+

C@thy

 

[@+Thierry]

Bonjour C@thy, Yaehou, Phibou, FDI, Abel, Michel (Bugs), DidierMDF, Michel (pas Bugs)

Je tombe par hazard sur ce fil, une autre approche, simple et radicale même si il y a des "Suppress" sur 100 lignes d'afilé à la suite... Mais à condition que C@thy n'ait pas des commentaires en colonne "D" sinon Aie Aie Aie !!!

Sub SuppressSupress()
Dim C As Range
Dim Firstaddress As String
Dim TheTime As Long

With ActiveSheet.Columns(4)
Set C = .Find("Suppr", LookIn:=xlValues)
If Not C Is Nothing Then
Firstaddress = C.Address
Do
C.AddComment "ToKill"
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Firstaddress
End If

On Error Resume Next 'si pas de "Suppr"
.SpecialCells(xlCellTypeComments).EntireRow.Delete

End With
End Sub

Bonne Fin d'Aprèm

 

[C@thy]

Ah ben ça tombe bien, j'm'en va tester ça.

Merci Thierry

Biz

C@thy

 

[yeahou]

Bonjour tout le monde

Je n'aurai qu'un seul mot, Thierry, BRAVO!
Ton programme est sans contestation possible le plus rapide. Je retourne plancher sur mon code pour l'améliorer.

Cordialement, A+

 

[C@thy]

'jour tout le monde,

j'ai testé la macro de Thierry, ça marche super nickel.

Merci à tous et bonne journée

C@thy

 

[Abel]

Tous,

Ah la vache !

Ca dépote !


Que de chemins pour aller au r... heu non ! à Rome.


Abel.

 

[@+Thierry]

Bonjour C@thy, Yeahou, le Fil, le Forum


Hi hi hi merci Yeahou et C@thy, alors vous voulez plus rapide encore ?

&nbsp;&nbsp;Oui ?


&nbsp;&nbsp;&nbsp;Sûr ???


&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;OK !!

Sub BipBipLoLLoLLoL()

With ActiveSheet
.Range("A1").AutoFilter Field:=4, Criteria1:="=*suppr*"
On Error Resume Next
.Range("A2:A" & .Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.ShowAllData
End With
End Sub


J'ai trouvé çà pour Robert et Julien par hazard ce matin Lien supprimé puis j'ai repensé à toi C@thy !


Bonne Journée
@+Thierry

 

[@+Thierry]

Arf Bonjour Abel, sorry je n'avais pas raffraichi l'écran !

Merci et Bonne Journée à toi aussi
@+Thierry

 

[Abel]

Pas de mal.

 

[C@thy]

Bravo Thierry, c'est génial et hyper rapide, foi de bip bip!!!!

C@thy

 

[PhiBou]

Bonjour le Fil, le Forum,

Alors là @+Thierry j'en reste sur le c..

Bon après-midi

PhiBou

 

[C@thy]

Merci à tous pour votre aide, c'est vraiment super.

En fait, ça se gâte : mon problème est plus complexe
(nan, j'ai pas de complexes!)

je vais essayer d'être claire :

sur les feuilles 5 à 8 je dois supprimer les lignes dont la colonne obervations
contient "suppr"... jusque là ça va,

là où ça se complique c'est que sur la feuille 4 j'ai 3 lignes de titres,
sur les feuilles 5 à 8 j'ai 6 lignes de titres, donc pas facile pour le filtre,

et où ça se corse encore plus (niark!)

c'est que la colonne observations n'est pas au même endroit :

sur la feuille 5 elle est en R, sur la feuille 6 elle est en AJ,
sur la feuille 7 elle est en Q, sur la feuille 8 elle est en AD

j'ai pas réussi ce prodige en bidouillant la macro de @+Thierry, alors j'ai
essayé de bidouiller celle d'Abel.

ça me donne :
(pitié, ne riez pas SVP! je ne suis pas pro en VBA!)

Sub Suppress()
Dim C As Range
Dim lig As Long
Dim ligTrans As Byte
Dim col As Byte
Dim sh As Byte
Dim plage

For sh = 5 To 8
'Windows("TESTCB.xls").Activate

Select Case sh
Case 5
col = 18 'R
ligTrans = 4
Case 6
ligTrans = 7
col = 17 'Q
Case 7
col = 36 'AJ

ligTrans = 7
Case 8
col = 30 'AD
ligTrans = 7
End Select

Sheets(sh).Select
Set plage = Range(Cells(ligTrans, col), Cells(65536, ActiveCell.Column).End(xlUp))
For Each C In plage
lig = C.Row
While Not plage(lig - 1).Find("suppr") Is Nothing
Rows(lig).Delete
Wend
Next
Next
End Sub

et il ne me fait que la 1ère ligne, et encore, il ne la supprime pas!!!

Can you help me????

merci beaucoup à vous, au moins d'avoir pris le temps de me lire,
et bon ouikend.

C@thy

 

[Yeahou]

Bonjour Cathy, le forum

Ce code fonctionnera, même si il est moins rapide que celui de Thierry (quand même, sur un petit tableau, il te faudra un chrono indiquant les centièmes de secondes pour voir la différence).
Il détecte la présence de la valeur "Observations" sur les lignes de 1 à 6, il s'arréte sur la première cellule correspondante rencontrée et supprime les lignes en fonction des valeurs de la colonne détectée. Il fonctionnera sur la feuille active quelque soit le cas de figure parmi ceux que tu as énoncé.

Cordialement, A+

Sub Supprimer_Lignes_Cathy()
'définition des variables
Dim Tab_Cells As Variant, Tab_Row() As String, Plage_Test As Range, Mem_Row As Long
Dim Compteur As Long, Compteur2 As Long, Colonne_Test As Integer
'désactivation de l'affichage écran pour gagner en rapidité
Application.ScreenUpdating = False
With ActiveSheet
Mem_Row = 0
Colonne_Test = 0
For Each Plage_Test In .Range("A1:IV6")
If UCase(Plage_Test.Value) = "OBSERVATIONS" Then Colonne_Test = Plage_Test.Column: Mem_Row = Plage_Test.Row: Exit For
Next Plage_Test
If Colonne_Test > 0 Then
Set Plage_Test = .Range(.Range("A1").Offset(Mem_Row, Colonne_Test - 1).Address & ":" & .Range("A1").Offset(.Range("A1").SpecialCells(xlCellTypeLastCell).Row - 1, Colonne_Test - 1).Address)
Tab_Cells = Plage_Test.Value
Compteur = 0
For Compteur2 = LBound(Tab_Cells) To UBound(Tab_Cells)
If InStr(1, Tab_Cells(Compteur2, 1), "SUPPR", 1) > 0 Then
Compteur = Compteur + 1
'on redimensionne en conservant les valeurs
ReDim Preserve Tab_Row(1 To Compteur) As String
Tab_Row(Compteur) = (Compteur2 + Mem_Row) & ":" & (Compteur2 + Mem_Row)
End If
Next Compteur2
'on efface les lignes détectées en partant de la fin
For Compteur2 = Compteur To 1 Step -1
.Range(Tab_Row(Compteur2)).Delete Shift:=xlUp
Next Compteur2
End If
End With
End Sub

 

[C@thy]

Merci Yeahou, j'm'en vas tester ça, reste plus qu'à espérer qu'ils ne mettent
pas Obs ou Commentaires!

Bonne journée

C@thy

 

[C@thy]

Salut Yeahou,

j'ai adapté un peu à ma sauce, avec une boucle sur les 4 feuilles, ça marche
très bien. Sûrement que si @+Thierry passe par là, il va trouver plus rapide,
mais pour l'instant j'adopte ta soluce.

Merci

C@thy