[RESOLU] - [VBA / EXCEL 365] Boucle pour supprimer si une cellule contient une valeur cible

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

J'ai un classeur qui contient une date de trop sur toutes les feuilles. Le problème c'est que cette date doit être supprimer car elle génère des erreurs lié aux valeurs qui sont sur la même ligne. Il me faut donc supprimer toutes les lignes qui sont sur cette date.

Je voulais savoir si vous pouviez m'aider sur ma macro. Je cherche à scanner chaque feuille qui contient la date concernée et qui, peu importe la position de la celulle, me supprimer la ligne entière de la cellule.
Je ne peux pas vous donner l'ensemble du fichier avec toutes les données, je vous ai donc fait une copie simplifiée avec 3 feuilles pour illustrer mon propos.
J'ai également commencer une macro, mais je bloque :

Je souhaite supprimer toutes les lignes dont la date est le 26 décembre, formaté "26-déc"

Si il y a déjà un article traité à ce sujet, je serais ravie d'avoir le lien :)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub Supprimer() Dim Ws As Worksheet For Each Ws In Worksheets Cells.Find(What:="26-déc", After:=ActiveCell, LookIn:=xlValues, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate ActiveSheet.Rows(ActiveCell.Row).EntireRow.Delete Next MsgBox "Les cellules ont été supprimées" End Sub
Sauf qu'il me manque l'objet . J'ai donc rajouté la variable
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub Supprimer() Dim Ws As Worksheet Dim Cell As Range For Each Ws In Worksheets 'La colonne de date peut varier d'une feuille à une autre, c'est un gros fichier d'entreprise, donc je ne voulais pas définir de plage particulière, simplement que la boucle s'arrête une fois que toutes les dates sont supprimées For Each Cell In Range("A:AR") Cells.Find(What:="26-déc", After:=ActiveCell, LookIn:=xlValues, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate ActiveSheet.Rows(ActiveCell.Row).EntireRow.Delete Next Cell Next Ws MsgBox "Les cellules ont été supprimées" End Sub
Mais cela ne marche toujours pas. J'ai toujours l'erreur 91.

Merci à vous.

18/12/2023, 15h13
Valtrase
Salut,

Sert-toi de l'exemple de Crosoft et de la méthode Find et FindNext
Attention Find ne s'arrête pas donc bien vérifier en fin de boucle que C = Nothing et que C.Address <> FirstAddress
Si tu as plusieurs lignes à effacer sur une feuille tu dois
- Soit décompter de la dernière ligne jusqu'à la première et supprimer celle qui correspond au critère
  - C.EntireRow.Delete
- Soit Utiliser la Méthode Union et les supprimer après la boucle.

Salut, s'il n'y a qu'une seule occurence par feuille, tu peux faire comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Supprimer()
    Dim Ws As Worksheet
    Dim Cell As Range
 
    For Each Ws In Worksheets
        Set Cell = Ws.Cells.Find(What:="26-déc")
        If Not Cell Is Nothing Then
            Cell.EntireRow.Delete
        End If
        Set Cell = Nothing
    Next Ws
    MsgBox "Les cellules ont été supprimées"
End Sub

Re,
Et en complément de la réponse à Franc, si tu as plusieurs lignes dans chaque feuilles :

Code:

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
30
31
32
33
34
35
36
Public Function deleteDate(DateValue As String, Optional Workbook As Excel.Workbook) As Long
    Dim localworkbook As Excel.Workbook
    Set localworkbook = Workbook
    If localworkbook Is Nothing Then Set localworkbook = ThisWorkbook
 
 
    Dim ItemSheet As Excel.Worksheet
    For Each ItemSheet In localworkbook.Worksheets
        Dim Searchedrange As Excel.Range
        Set Searchedrange = Nothing
 
        With ItemSheet.UsedRange
            Set Searchedrange = .Find(DateValue, LookIn:=xlValues)
            If Not Searchedrange Is Nothing Then
                Dim firstAddress As String
                firstAddress = Searchedrange.Address
                Do
                    Dim LinesToDelete As Range
                    If LinesToDelete Is Nothing Then
                        Set LinesToDelete = Searchedrange.EntireRow
                    Else
                        Set LinesToDelete = Union(LinesToDelete, Searchedrange.EntireRow)
                    End If
                    Set Searchedrange = .FindNext(Searchedrange)
                    Dim Counter As Long
                    Counter = Counter + 1
                Loop While Not Searchedrange Is Nothing And firstAddress <> Searchedrange.Address
            End If
            If Not LinesToDelete Is Nothing Then
                LinesToDelete.Delete
                Set LinesToDelete = Nothing
            End If
        End With
    Next ItemSheet
    deleteDate = Counter
End Function

Avec la procédure de test :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Sub TestDeleteDate()
    Dim Counter As Long
    Counter = deleteDate("26-déc.")
    Select Case Counter
        Case Is = 0
            Dim Messade As String
            Message = "Aucune date n'a été trouvée !"
        Case Is = 1
            Message = "Une ligne a été supprimée !"
        Case Is > 1
            Message = Counter & " lignes ont été supprimées !"
    End Select
    MsgBox Message
End Sub

20/12/2023, 12h41
Lilas43

Bonjour à tous les deux,

Je n'en attendais pas autant, les deux fonctionnent superbement bien.
Valtrase je pense qu'il m'aurait fallu un petit moment avant d'arriver à ta solution ! Fort heureusement il n'y avait que une fois la date par feuille.

Merci à vous deux. Je passe ce sujet en résolu.