Suppresion ligne

[Floflo62]

Bonjour, mon classeur comporte 3 feuilles. Je souhaiterais sur la 1ere feuille, supprimer toutes les lignes dont la case de la 5eme colonne est de couleur rouge mais également supprimer les lignes de 9 à 12 sur les feuilles 2 et 3 du classeur et tout ca dans la meme macro. J'ai regardé sur OpenClassrooms, mais je m'y perd un peu! Merci.

 

[DoubleZero]

Re : Suppresion ligne

Bonjour à toutes et à tous,

Bienvenue sur XLD, Floflo62.

Comme ceci ?

Option Explicit
Sub Supprimer()
    Dim i As Long, o As Object
    Application.ScreenUpdating = False
    With Sheets("a") ' nom adapter
        For i = .Cells(Rows.Count, "e").End(xlUp).Row To 1 Step -1
            If .Range("e" & i).Interior.ColorIndex = 3 Then .Rows(i).Delete
        Next
    End With
    For Each o In Worksheets(Array("b", "c")) ' noms adapter
        o.Rows("9:12").Delete Shift:=xlUp
    Next
    Application.ScreenUpdating = True
End Sub

A bientôt

 

[Floflo62]

Re : Suppresion ligne

Bonjour DoubleZero et merci d'avoir pris le temps de me répondre.
J'ai recopié le code mais il y a un détail que j'ai oublié de mentionner. Pour ce qui de la suppression des lignes dans les feuilles 2 et 3, elle ne doit avoir lieu qu'une seule fois. Le fait de lancer la macro par inadvertance ne pose aucun problème pour la feuille 1 mais pour les feuilles 2 et 3 oui, puisque les lignes d'en-dessous remontent et sont à leur tour supprimées!
Ensuite j'ai oublié autre chose, j'aurais également souhaiter changer le texte dans la cellule B2, le remplacer par "planning corrigé" en gras et noir.
Merci.

 

[DoubleZero]

Re : Suppresion ligne

Re-bonjour,

Une bonne habitude à prendre, lors de la création d'une discussion : joindre un fichier exemple, sans aucune donnée confidentielle, reflétant l'existant et le souhaité.

Dès lors, nul ne perdra son temps.

A bientôt

 

[job75]

Re : Suppresion ligne

Bonjour Floflo62, hello chère DoubleZero

Si l'on veut que la macro ne supprime pas systématiquement les lignes, il faut les repérer.

Avec des "x" en colonne E :

Sub SupprimerLignesX()
Dim col%, f, colaux%
col = 5 'colonne E
Application.ScreenUpdating = False
On Error Resume Next 'si aucun "x" en colonne col
For Each f In Array(Feuil1, Feuil2, Feuil3) 'CodeNames des feuilles à traiter
  With f.UsedRange
    colaux = .Columns.Count + 1
    .Columns(colaux).FormulaR1C1 = "=1/(RC" & col & "<>""x"")"
    .Columns(colaux) = .Columns(colaux).Value 'supprime les formules
    .EntireRow.Sort .Columns(colaux), xlAscending, Header:=xlNo 'tri pour accélérer
    .Columns(colaux).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
    .Columns(colaux) = "" 'RAZ
  End With
  With f.UsedRange: End With 'actualise la barre de défilement
Next f
End Sub

Si l'on veut les supprimer à partir des cellules vides en colonne E c'est du même acabit :

Sub SupprimerLignesVides()
Dim col%, f, colaux%
col = 5 'colonne E
Application.ScreenUpdating = False
On Error Resume Next 'si aucune cellule vide en colonne col
For Each f In Array(Feuil1, Feuil2, Feuil3) 'CodeNames des feuilles à traiter
  With f.UsedRange
    colaux = .Columns.Count + 1
    .Columns(colaux).FormulaR1C1 = "=1/(RC" & col & "<>"""")"
    .Columns(colaux) = .Columns(colaux).Value 'supprime les formules
    .EntireRow.Sort .Columns(colaux), xlAscending, Header:=xlNo 'tri pour accélérer
    .Columns(colaux).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
    .Columns(colaux) = "" 'RAZ
  End With
  With f.UsedRange: End With 'actualise la barre de défilement
Next f
End Sub

Ces macros n'utilisent pas de boucle sur les lignes, elles sont très rapides.

A+

 

[Floflo62]

Re : Suppresion ligne

Bonjour,
désolé pour mon 1er message, j'aurais en effet du joindre une copie de notre fichier. C'est maintenant chose faite.
Sur la 1ere page, les lignes à supprimer sont celles en rouge, de manière à ne sortir un planning "HOMME".
D'ailleurs est il possible de changer le texte dans la case fusionnée en haut? Y mettre "PLANNING HOMMES?"
Pour ce qui est des feuilles 2 et 3, les lignes à supprimer sont celles qui correspondent au PERSONNEL FEMININ, celle cellule étant fusionnée, je pensais qu'il serait plus simple de nommer les lignes par leur numéro, mais cette suppression ne doit intervenir qu'une seule fois.
Voila, désolé encore pour le 1er message.

 

[DoubleZero]

Re : Suppresion ligne

Bonjour, Floflo62, cher job75 , le Forum,

Une autre version avec le code suvant :

Option Explicit
Sub Supprimer_v2()
    Dim o As Object
    Application.ScreenUpdating = False
    If ActiveSheet.Name <> "PLANNING HOMME FEMME" Then Exit Sub
    Range("b6:l65000").AutoFilter Field:=1, Criteria1:=RGB(255, 0 _
                                , 0), Operator:=xlFilterCellColor
    Rows("7:" & Rows.Count).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Range("b6:l65000").AutoFilter Field:=1
    If Range("h2").Value = "PLANNING ROULAGE PROJET H/F" Then
        For Each o In Worksheets(Array("SEMESTRE 1", "SEMESTRE 2"))
            On Error Resume Next
            o.Activate
            With o
                .Cells.Find(What:="PERSONNEL FEMININ", After:=ActiveCell, LookIn:=xlValues _
              , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Resize(, 256).Select
                With Selection: .UnMerge: .Delete Shift:=xlUp: End With
                .Range("a1").Select
            End With
        Next
        Sheets("PLANNING HOMME FEMME").Activate
        Range("h2").Value = "PLANNING HOMMES"
        Exit Sub
    End If
    Application.ScreenUpdating = True
End Sub

A bientôt

 

[Floflo62]

Re : Suppresion ligne

Merci beaucoup!

 

[Floflo62]

Re : Suppresion ligne

Une dernière question, si la couleur devient rose et non plus rouge, si c'est une couleur que l'on choisit dans là palettes que propose excel quel morceau du code doit être changé?

 

[DoubleZero]

Re : Suppresion ligne

Re-bonjour,

Il faut adapter ces valeurs :

RGB(255, 0, 0)

Pour connaître le code couleur d'une cellule :

A bientôt

 

[job75]

Re : Suppresion ligne

Bonjour Floflo62, DoubleZero, le forum,

Supprimer des lignes ? Il vaut beaucoup mieux les masquer

Le bouton affiche successivement les hommes, les femmes, le planning complet :

Sub Planning()
Dim homme As Boolean, femme As Boolean, w As Worksheet, c As Range
With Feuil1.DrawingObjects("Ellipse 1") 'à adapter
  .Parent.[H2] = .Text
  homme = .Text Like "*H*"
  femme = .Text Like "*F*"
  If homme Then .Text = "PLANNING FEMMES"
  If femme Then .Text = "PLANNING COMPLET"
  If Not (homme Or femme) Then .Text = "PLANNING HOMMES"
End With
Application.ScreenUpdating = False
For Each w In Worksheets
  w.Rows.Hidden = False 'affiche tout
  For Each c In Intersect(w.[A:B], w.UsedRange.EntireRow)
    If homme Then
      If c.Interior.ColorIndex = 3 Or c Like "*FEMI*" Then _
        c.MergeArea.EntireRow.Hidden = True
    ElseIf femme Then
      If c.Interior.ColorIndex = 6 Or c Like "*MASCU*" Then _
        c.MergeArea.EntireRow.Hidden = True
    End If
Next c, w
End Sub

Fichier joint.

Edit : j'ai renseigné la cellule H2 comme demandé.

Bonne journée.

 

[job75]

Re : Suppresion ligne

Re,

Si l'on ne veut pas du planning complet c'est évidemment plus simple :

Sub Planning()
Dim homme As Boolean, w As Worksheet, c As Range
With Feuil1.DrawingObjects("Ellipse 1") 'à adapter
  .Parent.[H2] = .Text
  homme = .Text Like "*H*"
  .Text = "PLANNING " & IIf(homme, "FEMMES", "HOMMES")
End With
Application.ScreenUpdating = False
For Each w In Worksheets
  w.Rows.Hidden = False 'affiche tout
  For Each c In Intersect(w.[A:B], w.UsedRange.EntireRow)
    If homme Then
      If c.Interior.ColorIndex = 3 Or c Like "*FEMI*" Then _
        c.MergeArea.EntireRow.Hidden = True
    Else
      If c.Interior.ColorIndex = 6 Or c Like "*MASCU*" Then _
        c.MergeArea.EntireRow.Hidden = True
    End If
Next c, w
End Sub

Edit : cellule H2 renseignée.

Fichier (2).

A+

 

[job75]

Re : Suppresion ligne

Re,

Quand il s'agit de choisir on utilise généralement une liste de validation plutôt qu'un bouton.

La macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim homme As Boolean, femme As Boolean, w As Worksheet, c As Range
With [B3] 'cellule à adapter
  If Intersect(Target, .Cells) Is Nothing Then Exit Sub
  homme = .Value Like "*H*"
  femme = .Value Like "*F*"
End With
Application.ScreenUpdating = False
For Each w In Worksheets
  w.Rows.Hidden = False 'affiche tout
  For Each c In Intersect(w.[A:B], w.UsedRange.EntireRow)
    If homme Then
      If c.Interior.ColorIndex = 3 Or c Like "*FEMI*" Then _
        c.MergeArea.EntireRow.Hidden = True
    ElseIf femme Then
      If c.Interior.ColorIndex = 6 Or c Like "*MASCU*" Then _
        c.MergeArea.EntireRow.Hidden = True
    End If
Next c, w
End Sub

Fichier (3).

A+

 

[job75]

Re : Suppresion ligne

Re,

Pour finir, on peut utiliser une ComboBox (contrôle ActiveX) :

Private Sub ComboBox1_GotFocus()
ComboBox1.List = Array("PLANNING HOMMES", "PLANNING FEMMES", "PLANNING COMPLET")
End Sub

Private Sub ComboBox1_Change()
Dim homme As Boolean, femme As Boolean, w As Worksheet, c As Range
With ComboBox1
  If .ListIndex = -1 Then .Text = .List(2)
  homme = .Text Like "*H*"
  femme = .Text Like "*F*"
End With
Application.ScreenUpdating = False
For Each w In Worksheets
  w.Rows.Hidden = False 'affiche tout
  For Each c In Intersect(w.[A:B], w.UsedRange.EntireRow)
    If homme Then
      If c.Interior.ColorIndex = 3 Or c Like "*FEMI*" Then _
        c.MergeArea.EntireRow.Hidden = True
    ElseIf femme Then
      If c.Interior.ColorIndex = 6 Or c Like "*MASCU*" Then _
        c.MergeArea.EntireRow.Hidden = True
    End If
Next c, w
End Sub

Sur les premières versions d'Excel c'est d'ailleurs nécessaire car les listes de validation ne créent pas d'évènement Change.

Fichier (4).

A+