Condition dans un filtre

S

Sonskriverez

Guest
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 ?
 
S

Sonskriverez

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

Sonskriverez

Guest
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

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

andré

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

Nous a quitté
Repose en paix
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
 

Discussions similaires

Statistiques des forums

Discussions
312 799
Messages
2 092 239
Membres
105 298
dernier inscrit
doudounapnap