Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 VBA - erreur dans code

D

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

douguy à dit:
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
Cliquez pour agrandir...
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
douguy à dit:
If .Range("A2") >= .Range("A" & i) And...
Cliquez pour agrandir...
Trier par date Trier par votes

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:
Vote positif 0 Vote négatif

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:
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
D

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:
Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc
Bonjour @douguy @patricktoulon

douguy à dit:
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
Cliquez pour agrandir...
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
douguy à dit:
If .Range("A2") >= .Range("A" & i) And .Range("AF" & i) = 0 Then
sinon le code conservait aussi les lignes équivalente à A2
Cliquez pour agrandir...

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:
Vote positif 0 Vote négatif
Solution
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

P
  • Résolu(e)
XL 2013 EXCEL VBA
Réponses
2
Affichages
330
pangasoul
P
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
605
laurent950
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
532
AtTheOne
A
  • Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
138
patricktoulon
M
  • Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
350
Gégé-45550
R
  • Question
XL 2019 Demande à la macro de chercher et de remplir automatiquement jusqu'à la dernière valeur
Réponses
1
Affichages
439
Aya_flo
A
S
  • Résolu(e)
XL 2019 Problème de remplissage cellule en vba
Réponses
5
Affichages
346
snoopy07
S
M
  • Résolu(e)
XL 2021 PUBLIPOSTAGE : Mise en forme du corps de message issu d'une cellule excel (VBA)
Réponses
4
Affichages
373
Minus&Cortex
M
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
373
CathyLD
C
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…