Macro VBA suppresion de lignes qd contenu

Question

Bonjour,
ca fait des jours que j'essaie d'avoir une solution en VBA (je suis debutante). 
Je souhaite faire une macro qui me fait le sous total automatique du nombre de jour par personne (ca j'y arrive sans probleme) et ensuite supprimer uniquement les lignes ou le sous total est <5 jours (sans supprimer le detail). Que faire?
Merci enormement d'avance.
Frany

Utilisateur anonyme · Answer

Bonjour,

exemple :


Option Explicit
'

Sub EffaceLigne()

    Dim Plage As Range, Cellule As Range
    
    Set Plage = Range("A2:A25")
    
    For Each Cellule In Plage
        If (Cellule.Value < 5) Then
            Cellule.EntireRow.Delete
        End If
    Next Cellule
    
End Sub

Lupin

frany12 · Answer

Bonsoir Lupin,

Merci pour ton aide. 
Ca marche mais pas comme je le souhaite...
En fait je souhaite effacer uniquement les lignes de sous totaux qui apparaissent comme des cellules speciales ci dessous (car je fais un sous-total automatic) 

' Selection.SpecialCells(xlCellTypeFormulas, 1).Select'

je ne veux pas supprimer les lignes ou se trouvent le detail

Merci encore ca me fera un gros soulagement qd j'aurai trouve la solution.

Frany

Utilisateur anonyme · Answer

re:

Il me manque beaucoup d'information pour créer l'algorithme, mais voici une autre méthode !


Sub EffaceSelection()

    Dim Cellule As Range
    
    Selection.SpecialCells(xlCellTypeFormulas, 1).Select
    For Each Cellule In Selection
        If (Cellule.Value < 5) Then
            Cellule.EntireRow.Delete
            Range("A1").Select
            Selection.SpecialCells(xlCellTypeFormulas, 1).Select
        End If
    Next Cellule
    
End Sub
'

Lupin

Utilisateur anonyme · Answer

re:

je commence à voir la feuille ...

Semaine1                                    Semaine2
Alain
                     Projet1     1j                                Projet1    1j
                     Projet2     2j                                Projet2    2j
                     Projet3     1j                                Projet3    3j
Totaux        Total          4j                                Total         6j
Semaine1                                    Semaine2
Pierre
                     Projet1     2j                                Projet1    1j
                     Projet2     2j                                Projet2    1j
                     Projet3     2j                                Projet3    3j
Totaux        Total          6j                                Total         5j
Semaine1                                    Semaine2
Claude
                     Projet1     1j                                Projet1    1j
                     Projet2     2j                                Projet2    1j
                     Projet3     1j                                Projet3    1j
Totaux        Total          4j                                Total         3j

si j'ai bien compris, ici il faut supprimer les lignes se reportant à Claude et conserver les deux autres ?

pour conserver une certaine tabulation de tes posts, place ton texte entre les balises de code !

........<.......code...........>............

                    texte          texte
                    texte          texte

.........<.../...code.......>...........

sans les points pour les balises, je l'ai ai inclus car les balises ne sont pas visible dans le message.

Lupin

Frany12 · Answer

Bonjour Lupin,
En effet il faut supprimer les lignes de Claude.
Merci aussi pour l'astuce du code. Tres utile.

Utilisateur anonyme · Answer

re :

autre question avant de te pondre un exemple !

Peut-il y avoir un nombre différent de projet 

.........a) pour une semaine donnée
.........b) pour une personne donnée

avec ces infos je devrais pour pondre quelque chose de viable :-)

Lupin

Frany12 · Answer

Il peut y avoir un nombre different de projets par personne.
Normalement le nombre de projets ne change pas s'une semaine a l'autre (mais cela peut etre envisage)

Merci 
Francy

Utilisateur anonyme · Answer

Bonjour,

Voilà, j'ai tardé un peu, cette algo m'a donné un peu de difficulté :-)

voici l'exemple :

http://www.forum-openoffice.org/ci-joint/fichier/2007/08/09-112154.xls

et le code lui-même :

Option Explicit

Sub Nettoyage()

    Const AdresseFin = 11

    Dim Lignes() As Long, Compteur As Long
    Dim PremiereLigne As Long, DerniereLigne As Long, Limite As Long
    Dim Cellule As Range, Plage As Range, Drapeau As Boolean
    
    Application.ScreenUpdating = False
    Selection.SpecialCells(xlCellTypeFormulas, 1).Select
    Compteur = 1
    For Each Cellule In Selection
        If (Cellule.Value < 5) Then
            ReDim Preserve Lignes(Compteur)
            Lignes(Compteur - 1) = Cellule.Row
            Compteur = (Compteur + 1)
        End If
    Next Cellule

    Compteur = 0
    For Compteur = 0 To (UBound(Lignes) - 1)
        Cells(Lignes(Compteur), 1).Select
        Set Plage = Range(ActiveCell.Offset(0, 0).Address, ActiveCell.Offset(0, AdresseFin).Address)
        Plage.Select

        Drapeau = False
        For Each Cellule In Plage
            If (Cellule.FormulaLocal <> Cellule.Value) Then
                If (Cellule.Value > 5) Then
                    Drapeau = True
                    Range("A" & Cellule.Row).Value = "Conserver"
                    Exit For
                Else
                    Range("A" & Cellule.Row).Value = "Détruire"
                    DerniereLigne = Cellule.Row
                    Limite = DerniereLigne
                End If
            End If
        Next Cellule
    Next Compteur
    
    Drapeau = True
    
    While (Drapeau)
        Range("A" & DerniereLigne).Select
        ActiveCell.Offset(-1, 0).Select
        While (ActiveCell.Offset(0, 0).Value = "")
            ActiveCell.Offset(-1, 0).Select
            If (ActiveCell.Row = 1) Then
                Drapeau = False
            End If
        Wend
        PremiereLigne = ActiveCell.Offset(0, 0).Row
        Rows(PremiereLigne & ":" & DerniereLigne).Select
        Selection.Delete
        DerniereLigne = Range("A" & (PremiereLigne - 1)).Row
        If (Range("A" & DerniereLigne).Value = "Conserver") Then
            Range("A" & (DerniereLigne - 1)).Select
            While (ActiveCell.Offset(0, 0).Value <> "Détruire") And (Drapeau)
                ActiveCell.Offset(-1, 0).Select
                If (ActiveCell.Row = 1) Then
                    Drapeau = False
                End If
            Wend
            DerniereLigne = ActiveCell.Offset(0, 0).Row
        End If
    Wend
    
    Range("A" & Limite).Select
    While (ActiveCell.Offset(0, 0).Row > 1)
        If (ActiveCell.Offset(0, 0).Value = "Conserver") Then
            ActiveCell.Offset(0, 0).Value = ""
        End If
        ActiveCell.Offset(-1, 0).Select
    Wend
    Application.ScreenUpdating = True
    
End Sub
'

Lupin

frany12 · Answer

Bonjour Lupin,
Ca c'est du code!!!! Merci infiniment.
Cependant je n'arrive pas completement a executer la macro sur mon fichier. J'ai teste sur ton fichier c'est impeccable.

Il bloque apres drapeau= true sur le 1er :
ActiveCell.Offset(-1, 0).Select
Je ne comprends pas trop pourquoi?

PS precision supplementaire la presentation du tableau est comme ci-dessous

........<.......code...........>............
Alain sem1 sem2 sem3
Projet1 1 0 1
Projet2 2 1 1
Projet3 1 1 1
Projet4 2 1 1
Total 6 3 4

.........<.../...code.......>...........

Les noms commenc a la cellule D2, D3, D4,...D293 et les semaines a partir de K2:CH293
Peut-etre que ca change qqchose?

Utilisateur anonyme · Answer

Bonjour Frany,

Premier point :

les balises de code :

........<.......code...........>............
texte texte
texte texte

.........<.../...code.......>...........

sans les points pour les balises, je l'ai ai inclus car les balises ne sont pas visible dans le message.

pour donner un autre exemple, je remplace le mot [code] par le mot [Lupin]

<Lupin>
          sans          les          points
</Lupin>

Deuxième point :

Effectivement, la structure de la feuille est très importante, avec les infos que tu m'as
fournit : [ Les noms commenc a la cellule D2, D3, D4,...D293 et les semaines a partir de K2:CH293 ]
je vais tenter de regénérer la feuille, toutefois il serait plus efficace que tu place ton classeur
sur [ ci-joint ] comme j'ai fait si celui-ci ne contient pas d'information confidentiel.

Si ton classeur contient des informations confidentiel, recopie la feuille dans un nouveau
classeur et ne conserve que le première itération ( dans tes exemple celle de Alain ) en
modifiant les données sans modifier la structure.

Autre point :

Il serait aussi possible d'apprendre a débogger le code !

Tu place en commentaire les lignes :

    'Application.ScreenUpdating = False
    ...
    'Application.ScreenUpdating = True

et tu lance la macro en mode [ pas à pas détaillé ], ainsi tu peux suivre le code ligne à ligne !

Lupin

Utilisateur anonyme · Answer

re :

Les semaines ???
En commencant les semaine à la colonne K2 et en intercalant une colonne vide entre chaque, je me rends à la colonne DI2
Si j'omets d'intercaler un colonne vide, je me rends à la colonne BJ2

Les Noms ???
Les noms commenc a la cellule D2, D3, D4,...D293

si la structure est :

Alain
Projet1
Projet2
Projet3
Projet4
Total
Pierre
Projet1
Projet2
etc ...

J'obtiens pour les noms :

[ D2 : D8 : D14 : etc... ]

Je ne comprends pas bien la structure !

Lupin

frany12 · Answer

Bonjour Lupin,

Merci pour les commentaires plus haut. J'ai mis l'ossature de mon fichier sur ci joint: 
[url]http://www.forum-openoffice.org/ci-joint/fichier/2007/08/11-091650.xls[/url]

J'espere que ca t'aidera a avoir une vue plus precise. 
Je te remercie infiniment du temps que tu consacres a mon probleme.

Bon week end

Frany

Utilisateur anonyme · Answer

Bonjour Frany,

Alors voici ce que ça donne :

Option Explicit

Sub Nettoyage()

    Const AdresseFin = 86
    Const Detruire = "Kill"
    Const Conserver = "Keep"

    Dim Lignes() As Long, Compteur As Long, Boucle As Long
    Dim PremiereLigne As Long, DerniereLigne As Long, Limite As Long
    Dim Cellule As Range, Plage As Range, Drapeau As Boolean, Flag As Boolean
    
    Application.ScreenUpdating = False
    Selection.SpecialCells(xlCellTypeFormulas, 1).Select
    Compteur = 1
    For Each Cellule In Selection
        If (Cellule.Value < 5) Then
            ReDim Preserve Lignes(Compteur)
            Lignes(Compteur - 1) = Cellule.Row
            Compteur = (Compteur + 1)
        End If
    Next Cellule

    Compteur = 0
    For Compteur = 0 To (UBound(Lignes) - 1)
        Cells(Lignes(Compteur), 1).Select
        Set Plage = Range(ActiveCell.Offset(0, 0).Address, ActiveCell.Offset(0, AdresseFin).Address)
        Plage.Select

        Drapeau = False
        For Each Cellule In Plage
            If (Cellule.FormulaLocal <> Cellule.Value) Then
                If (Cellule.Value > 5) Then
                    Drapeau = True
                    Range("A" & Cellule.Row).Value = Conserver
                    Exit For
                Else
                    Range("A" & Cellule.Row).Value = Detruire
                    DerniereLigne = Cellule.Row
                    Limite = DerniereLigne
                End If
            End If
        Next Cellule
    Next Compteur
    
    Drapeau = True: Flag = True
    
    While (Drapeau) Or (Flag)
        Range("A" & DerniereLigne - 1).Select
        While ((ActiveCell.Offset(0, 0).Value <> Conserver) And (ActiveCell.Offset(0, 0).Value <> Detruire)) And (ActiveCell.Offset(0, 0).Row > 1)
            ActiveCell.Offset(-1, 0).Select
        Wend
        Drapeau = False
        PremiereLigne = ActiveCell.Offset(1, 0).Row
        Rows(PremiereLigne & ":" & DerniereLigne).Select
        Selection.Delete
        DerniereLigne = PremiereLigne - 1
        Range("A" & DerniereLigne).Select
        If (ActiveCell.Offset(0, 0).Value <> Detruire) Then
            While ((ActiveCell.Offset(0, 0).Value <> Detruire)) And (ActiveCell.Offset(0, 0).Row > 1)
                ActiveCell.Offset(-1, 0).Select
            Wend
        End If
        DerniereLigne = ActiveCell.Offset(0, 0).Row
        Range("A" & (DerniereLigne)).Select
        While ((ActiveCell.Offset(0, 0).Value <> Conserver) And (ActiveCell.Offset(0, 0).Value <> Detruire)) And (ActiveCell.Offset(0, 0).Row > 1)
            ActiveCell.Offset(-1, 0).Select
        Wend
        If (ActiveCell.Offset(0, 0).Row < 2) Then
            Flag = False
        End If
    Wend
    Range("A2").Select
    For Boucle = 0 To Limite
        If (ActiveCell.Offset(Boucle, 0).Value = Conserver) Then
            ActiveCell.Offset(Boucle, 0).Value = ""
        End If
    Next Boucle
    Range("A1").Select
    Application.ScreenUpdating = True
    
End Sub
'

Je tiens tout de même à te dire que l'algo n'est pas optimisé. J'ai travaillé à l'envers.
C'est à dire que j'ai codé avant de faire l'algo (i.e. d'avoir une vue d'ensemble).

Il n'y a pas de contrôle sur l'ossature du classeur, si des erreurs se glisse dans l"ossature
la macro va planter ou mal réagir.

Conseil pratique : Dans un classeur de donnée, conserve toujours la colonne A pour créer
un index si tu veux implanter du VBA, ce sera toujours plus simple. De plus, je ne suis pas
convaincu que l'utilisation de sous-total soit mieux qu'un simple total !

Alors voilà, bonne semaine, je demeure sur le fil ...

Lupin

frany12 · Answer

Bonsoir Lupin,
Le code plante lorsque je l'execute sur mon fichier au premier:

Range("A" & DerniereLigne - 1).Select

apres
Drapeau = True: Flag = True

While (Drapeau) Or (Flag)

Il faut que j'apprenne un peu plus le code VBA car j'avoue ne pas bien comprendre tout le code que tu as ecris.

Pour l'instant j'ai trouve une solution qui a l'air de marcher. J'ai fait un filtre automatique sur la base de donnees et ensuite clique sur la petite fleche a droite en entete de colonne de l'une des semaines, fais "custom autofilter" (j'utilise une version anglaise excel) et ai mis comme critere >=5... je vais verifier pour voir s'il a tout pris car a premiere vue ca a l'air d'etre bon : il n' affiche les lignes que lorsque il y a au moins un sous-total >=5 Voici ce que donne le code pour info:

<.......code...........>
Sub ensemble()
'
' showspecific5 Macro
' '
Range("F2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=11, Criteria1:=">=5", Operator:=xlAnd
End Sub

<.../...code.......>

Encore une fois un grand merci pour ton aide tout au long de la semaine. C'est sympa d'avoir des gens qui s'entraident comme cela.

PS: j'ai utilise un sous-total car toute debutante que je suis j'ai trouve cette solution automatique pratique plutot que de m'amuser a faire un sous-total conditionnel. Aurais-tu une solution simple pour faire une somme par personne plutot qu'un sous total quand tu as plusieurs lignes?

Bonne semaine,

Frany

Utilisateur anonyme · Answer

Bonjour Frany,

Dans un premier temps, récupère le prototype que j'ai fait et essai de voir les différence.

http://membre.oricom.ca/lupin/documents/ex_horaire.xls

n.b. ce lien n'est que temporaire et sera détruit après usage.

Je vais regarder s'il n'y aurait pas une autre approche pour ton besoin.

Cordialement

Lupin

Macro VBA suppresion de lignes qd contenu<5

15 réponses

Discussions similaires

Newsletters