Microsoft 365 VBA - erreur dans code

[douguy]

Bonjour à tous

Est ce qu'un expert peut m'aider sur cette macro ?
Elle devrait supprimer les lignes quand dans la colonne AA la valeur est 0
Elle préfère effacer tout !!!

merci beaucoup pour votre aide

Public Sub deleteUselessLinesFcst()
' supprime les lignes inutiles de la feuille res fcst
On Error Resume Next
Dim i As Double
Dim checkValue As String

With sh_res_fcst
i = 2
checkValue = CStr(.Cells(2, 1).Value)
While (Not IsEmpty(.Cells(i, 1)))
If (CStr(.Cells(i, 1).Value) <> checkValue Or .Cells(i, 27).Value = 0) Then '27 col AA
.Rows(i).Delete
Else
i = i + 1
End If
Wend
End With
End Sub

 

[Phil69970]

Bonjour @douguy, le forum

Si tu ne veux pas tout supprimer il faut modifier

If (CStr(.Cells(i, 1).Value) <> checkValue Or .Cells(i, 27).Value = 0) Then

Par :

If (CStr(.Cells(i, 1).Value) <> checkValue And .Cells(i, 27).Value = 0) Then

Apparemment tu n'est pas très pressé car la suppression prend un temps fou.....avec ton code

@Phil69970

 

[patricktoulon]

Bonsoir
je sais pas mais si tu réfléchi un peu tu te rend compte que ça ne peut que planter
tu boucle while avec incrémentation de "i" +1
des la première ligne deleter ça va planter forcement car la ligne suivante prend la place de la ligne deletée
c'est la base en VBA, comme dans d'autres langages d'ailleurs
on boucle a reculons pour deleter
ou on stock les index de ligne dans une variable de type array ou même une incrémentation d'un range avec union par exemple dans ta boucle

oserais je dire aussi qu'avec specialcells il t'est possible de cibler tes lignes
je parlerais d'un double filtre qu'est d'une simplicité

 

[Phil69970]

@douguy
Edit : Bonjour Patrick

Si tu es pressé je te propose ce code qui fonctionne et qui est beaucoup plus rapide....

Sub deleteUselessLinesFcst()
Application.ScreenUpdating = False
Dim Derlig&
With sh_res_fcst
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row
    For i = Derlig To 2 Step -1
        If .Range("A2") <> .Range("A" & i) And .Range("AA" & i) = 0 Then
            .Rows(i).Delete
        End If
    Next i
End With
End Sub

@Phil69970

 

[patricktoulon]

re
Bonsoir @Phil69970
ta macro revue ,elle supprime toutes les lignes d'un coup

Sub deleteUselessLinesFcst()
    Application.ScreenUpdating = False
    Dim Derlig&, rngsuppr As Range
    With sh_res_fcst
        Derlig = .Range("A" & Rows.Count).End(xlUp).Row
        'Derlig1 = .Range("A" & Rows.Count).End(xlUp).Row
        For i = Derlig To 2 Step -1
            If .Range("A2") <> .Range("A" & i) And .Range("AA" & i) = 0 Then
                If rngsuppr Is Nothing Then Set rngsuppr = .Cells(i, 1) Else Set rngsuppr = Union(rngsuppr, .Cells(i, 1))
            End If
        Next i
        rngsuppr.EntireRow.Delete
    End With
End Sub

 

[douguy]

Bonjour @patricktoulon @Phil69970
Merci beaucoup pour vos réponses et je vous prie de m'excuser de ma réponse tardive.
Le code est effectivement beaucoup plus rapide.

Par contre il laisse passer des lignes qui devraient être supprimées (elles répondent bien aux 2 conditions) pour une raison qui m'échappe

j'ai changé
If .Range("A2") <> .Range("A" & i) And .Range("AA" & i) = 0 Then
en
If .Range("A2") >= .Range("A" & i) And .Range("AF" & i) = 0 Then
sinon le code conservait aussi les lignes équivalente à A2

j'ai joint le nouveau classeur, on a par exemple le 30 mai qui reste alors qu'il devrait disparaitre.
Au plaisir de vous lire
Encore merci

 

[Phil69970]

Bonjour @douguy @patricktoulon

j'ai changé
If .Range("A2") <> .Range("A" & i) And .Range("AA" & i) = 0 Then
en
If .Range("A2") >= .Range("A" & i) And .Range("AF" & i) = 0 Then
sinon le code conservait aussi les lignes équivalente à A2

Non tu n'as pas changé que cela !!!
Que cela soit dans mon code ou celui de Patrick, nous avons écrit :

With sh_res_fcst

Et toi tu fais référence à l'autre feuille

With sh_res_stat

Et dans ton 2eme code ou tu fais bien référence à la bonne feuille tu n'as pas changé
If .Range("b2") >= .Range("b" & i) And .Range("AA" & i) = 0 Then
par
If .Range("b2") >= .Range("b" & i) And .Range("AF" & i) = 0 Then

If .Range("A2") >= .Range("A" & i) And .Range("AF" & i) = 0 Then
sinon le code conservait aussi les lignes équivalente à A2

Donc si tu veux être cohérent avec ta demande voila le code :

Sub deleteUselessLinesFcst()
Application.ScreenUpdating = False
Dim Derlig&
With sh_res_fcst
    Derlig = .Range("A" & Rows.Count).End(xlUp).Row
    For i = Derlig To 2 Step -1
        If .Range("A2") <> .Range("A" & i) And .Range("AF" & i) = 0 Then
            .Rows(i).Delete
        End If
    Next i
End With
End Sub

@Phil69970

 

[douguy]

Mon problème est résolu
je vous remercie