Microsoft 365 VBA - erreur dans code

douguy

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

Pièces jointes

  • Classeur1.xlsm
    403.8 KB · Affichages: 17
Solution
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 :

VB:
With sh_res_fcst
Et toi tu fais référence à l'autre feuille
VB:
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...

Phil69970

XLDnaute Barbatruc
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
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
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é
 
Dernière édition:

Phil69970

XLDnaute Barbatruc
@douguy
Edit : Bonjour Patrick

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

VB:
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

XLDnaute Barbatruc
re
Bonsoir @Phil69970
ta macro revue ,elle supprime toutes les lignes d'un coup
VB:
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

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

Pièces jointes

  • Classeur1.xlsm
    543.9 KB · Affichages: 7
Dernière édition:

Phil69970

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

VB:
With sh_res_fcst
Et toi tu fais référence à l'autre feuille
VB:
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 :

VB:
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
 
Dernière édition: