Discussion :

[Etrof]

Bonjour à tous,

Je souhaiterai obtenir un programme, qui me permettrait de supprimer une ligne en fonction du contenu d'une précédente cellule d'une colonne particulière pour chaque feuille de mon fichier Excel.
Concrètement dans le fichier dans lequel je travaille, je veux que mon programme supprime la deuxième ligne (ligne l+2), qui suit la ligne (l) dont le contenu de la colonne B est "Memo: Preferred Dividends Related to the Period". Puis, je veux qu'il supprime la deuxième ligne(k+2), qui la ligne (k) dont le contenu de la colonne B est "Memo: Fitch Eligible Capital".

Quelqu'un aurait-il une idée de programme, qui ferait l'affaire ?

Voici le lien du fichier sur lequel je travaille.
https://www.fichier-xls.fr/2016/07/06/hungary1/

Merci d'avance
Etrof

[Thautheme]

Bonjour Etrof, bonjour le forum,

Désolé, j'ai l'habitude de commenter mes codes mais là je ne pas le temps. Si tu en as besoin je le ferai plus tard...
Essaie comme ç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
19
20
21
22
23
24
25
26
27
Sub Macro1()
Dim O As Worksheet
Dim DL As Integer
Dim I As Integer
Dim TV As Variant
Dim TL() As Variant
Dim J As Integer
 
Application.ScreenUpdating = False
For Each O In Sheets
    J = 1
    DL = O.Range("B" & Application.Rows.Count).End(xlUp).Row
    TV = O.Range("B1:B" & DL)
    For I = 1 To UBound(TV, 1)
        If InStr(1, TV(I, 1), "Memo: Preferred Dividends Related to the Period", vbTextCompare) <> 0 Or InStr(1, TV(I, 1), "Memo: Fitch Eligible Capital", vbTextCompare) <> 0 Then
            ReDim Preserve TL(1 To J)
            TL(J) = I + 2
            J = J + 1
        End If
    Next I
    For I = UBound(TL) To LBound(TL) Step -1
        Rows(TL(I)).Delete
    Next I
Next O
Application.ScreenUpdating = True
MsgBox "Traitement des données terminé !"
End Sub

[Etrof]

J'ai testé ton programme mais VBA ne veut pas l'exécuter.
Cela m'affiche "Incompatibilité de type".
Ai-je fait une mauvaise manipulation ?
Mais merci en tout cas pour ta réponse !

[Philippe Tulliez]

Bonjour,
Une autre solution basée sur la méthode AdvancedFilter (filtre avancé d'excel).
Voir exemple Excel VBA – Supprimer des lignes suivant critères avec la méthode AdvancedFilter
Pour comprendre les filtres avancés à lire Les filtres avancés ou élaborés dans Excel

[Thautheme]

Bonjour Etrof, Philippe, bonjour le forum,

Bizarre !... Je l'ai testé sur ton fichier et ça a fonctionné. Aucun message d'erreur ! Ça t'affiche cette erreur sur quelle ligne (elle est surlignée de jaune) ?

Je profite pour te renvoyer le code commenté auquel j'ai juste rajouté la ligne Erase TL...

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
19
20
21
22
23
24
25
26
27
28
29
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim J As Integer 'déclare la variable J (incrément)
 
Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
    J = 1 'initialise la variable J
    Erase TL 'vide le tableau TL
    DL = O.Range("B" & Application.Rows.Count).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet O
    TV = O.Range("B1:B" & DL) 'définit la tableau des valeurs TV (les cellules éditées de la colonne B)
    For I = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
        'condition "si la donnée ligne I colonne 1 de TV contient un des deux textes
        If InStr(1, TV(I, 1), "Memo: Preferred Dividends Related to the Period", vbTextCompare) <> 0 Or InStr(1, TV(I, 1), "Memo: Fitch Eligible Capital", vbTextCompare) <> 0 Then
            ReDim Preserve TL(1 To J) 'redimensionne le tableau des lignes TL
            TL(J) = I + 2 'récupère dans la variable indexée TL(J) le numéro de ligne I + 2
            J = J + 1 'incrémente J
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    For I = UBound(TL) To LBound(TL) Step -1 'boucle inversée sur toutes les lignes stockées dans le tableau de lignes TL
        Rows(TL(I)).Delete 'efface la ligne TL(I)
    Next I 'prochaine ligne de la boucle inversée
Next O 'prochain onglet de la boucle 1
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
MsgBox "Traitement des données terminé !" 'message pour indiquer la fin de la macro
End Sub

[patricktoulon]

Bonsoir
Tautheme tout les chemin mènent a Rome n'est ce pas , du moment que c'est pas a pied ( ca use les souliers) hein!!!

Code :

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

1
2
3
4
5
6
7
Sub supprime_toto()
  With ActiveSheet.Range("$B$3:$B$24") ' plage a adapter
        .AutoFilter Field:=1, Criteria1:="toto" 'mot recherché a adapter
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
    End With
End Sub