Condition dans un filtre

[Sonskriverez]

Bonjour à tous et lerci de votre aide,

'Selectionne les lignes 'toto'
Worksheets('sheet1').Select
Worksheets('Sheet1').Range('A1').AutoFilter Field:=8, Criteria1:='=*toto*' 'Selectionne selon le critère
Set tbl = ActiveCell.CurrentRegion
Application.DisplayAlerts = False
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Delete
Application.DisplayAlerts = True
Selection.AutoFilter ' Enlève le filtre automatique

Ce petit bout de macro filtre suivant un critère et delete les lignes concernée.
Le Pbl est que si le critère n'existe pas, tous ce delete, comment poser une codition du style SI critère existe pas passe ?

 

[MichelXld]

bonjour

je t'ai répondu ici

Lien supprimé


bonne journée
MichelXld

 

[Sonskriverez]

Désolé Michelxld, j'ai essayé cela ne fonctionne pas.

dans l'exemple: le critère de la 1 ere boucle existe y'a pas de pbl, par contre le critère de 2ème n'existe pas et cela ne marche pas

Peut-être qu'il considère que la feuille n'est pas vide à cause de la ligne de filtre?

'Selectionne les lignes 'RESOLVED'
Worksheets('sheet1').Select
Worksheets('Sheet1').Range('A1').AutoFilter Field:=8, Criteria1:='=*RESOLVED*' 'Selectionne selon le critère
If Feuil1.Columns(1).SpecialCells(xlCellTypeVisible).Count <> 65536 Then
Set tbl = ActiveCell.CurrentRegion
Application.DisplayAlerts = False
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Delete
Application.DisplayAlerts = True
Selection.AutoFilter ' Enlève le filtre automatique
Else
Selection.AutoFilter ' Enlève le filtre automatique
End If

'Selectionne les lignes 'FRAMSLN'
Worksheets('Sheet1').Range('A1').AutoFilter Field:=7, Criteria1:='=*FRAMSLN*'
If Feuil1.Columns(1).SpecialCells(xlCellTypeVisible).Count <> 65536 Then
Set tbl = ActiveCell.CurrentRegion
Application.DisplayAlerts = False
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Delete
Application.DisplayAlerts = True
Selection.AutoFilter ' Enlève le filtre automatique
Else
Selection.AutoFilter ' Enlève le filtre automatique
End If

 

[Sonskriverez]

Désolé Michelxld, j'ai essayé cela ne fonctionne pas.

dans l'exemple: le critère de la 1 ere boucle existe y'a pas de pbl, par contre le critère de 2ème n'existe pas et cela ne marche pas

Peut-être qu'il considère que la feuille n'est pas vide à cause de la ligne de filtre?

'Selectionne les lignes 'RESOLVED'
Worksheets('sheet1').Select
Worksheets('Sheet1').Range('A1').AutoFilter Field:=8, Criteria1:='=*RESOLVED*' 'Selectionne selon le critère
If Feuil1.Columns(1).SpecialCells(xlCellTypeVisible).Count <> 65536 Then
Set tbl = ActiveCell.CurrentRegion
Application.DisplayAlerts = False
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Delete
Application.DisplayAlerts = True
Selection.AutoFilter ' Enlève le filtre automatique
Else
Selection.AutoFilter ' Enlève le filtre automatique
End If

'Selectionne les lignes 'FRAMSLN'
Worksheets('Sheet1').Range('A1').AutoFilter Field:=7, Criteria1:='=*FRAMSLN*'
If Feuil1.Columns(1).SpecialCells(xlCellTypeVisible).Count <> 65536 Then
Set tbl = ActiveCell.CurrentRegion
Application.DisplayAlerts = False
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Delete
Application.DisplayAlerts = True
Selection.AutoFilter ' Enlève le filtre automatique
Else
Selection.AutoFilter ' Enlève le filtre automatique
End If

 

[MichelXld]

bonjour

tu peux tester cette adaptation


Dim Tbl As Range, Plage As Range
Dim Cible As Long

Set Plage = Worksheets('Sheet1').Range('H1:H' & _
Worksheets('Sheet1').Range('H65536').End(xlUp).Row)

On Error Resume Next
Cible = Application.WorksheetFunction.Match('*RESOLVED*', Plage, 0)

If Cible > 0 Then
Worksheets('Sheet1').Range('A1').AutoFilter Field:=8, Criteria1:='=*RESOLVED*'
Set Tbl = ActiveCell.CurrentRegion
Application.DisplayAlerts = False
Tbl.Offset(1, 0).Resize(Tbl.Rows.Count - 1, Tbl.Columns.Count).Delete
Application.DisplayAlerts = True
Selection.AutoFilter ' Enlève le filtre automatique
End If

Set Plage = Worksheets('Sheet1').Range('G1:G' & _
Worksheets('Sheet1').Range('G65536').End(xlUp).Row)

On Error Resume Next
Cible = 0
Cible = Application.WorksheetFunction.Match('*FRAMSLN*', Plage, 0)

If Cible > 0 Then
'Selectionne les lignes 'FRAMSLN'
Worksheets('Sheet1').Range('A1').AutoFilter Field:=7, Criteria1:='=*FRAMSLN*'
Set Tbl = ActiveCell.CurrentRegion
Application.DisplayAlerts = False
Tbl.Offset(1, 0).Resize(Tbl.Rows.Count - 1, Tbl.Columns.Count).Delete
Application.DisplayAlerts = True
Selection.AutoFilter ' Enlève le filtre automatique
End If


bonne journée
MichelXld

 

[sonskriverez]

Ca marche, merci beaucoup. Par contre j'ai pas tout compris mais c'est le resultat qui compte...

 

[andré]

Salut sonskriverez,

Mauvaise philosophie !

Avec Excel et un minimum d'effort, il y a moyen de comprendre, parce que le raisonnement est logique.

Ce n'est pas le cas avec tout le monde !
Mais non mesdames, ce n'est pas à vous que je pense, enfin pas en deuxième instance.

Â+

 

[jeanpierre]

Bonsoir ce fil, André, le Forum,

André, t'as rien trouvé de mieux pour te faire des copines ?

Un week-end qui commence dans la bonne humeur...

Alors excellent week-end à tous et surtout à toi André, si c'est encore possible...

Jean-Pierre

 

[andré]

Salut jeanpierre,

Enfin quelqu'un qui me comprends !

Â+