Microsoft 365 VBA - erreur dans code

  • Initiateur de la discussion Initiateur de la discussion douguy
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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

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...
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:
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:
@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
 
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
 
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

Dernière édition:
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:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
236
Réponses
2
Affichages
201
Réponses
10
Affichages
281
Réponses
4
Affichages
177
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Réponses
5
Affichages
232
Retour