Supprimer colonne différente de 1

Bonjour à tous,

J'ai problème que je n'arrive pas à solutionner.

J'ai un gros tableau que souhaiterais diminuer, j'ai donc créer une colonne qui sort 1 ou 0. Si la cellule ressort un 0 je veux que la ligne soit supprimée.

Voici un fichier test et mon code VBA :

Dans ce fichier test je veux garder que les cellules qui sont égale à STZ, et donc donne 1.

Merci d'avance !

Bonne journée à tous !

Sub OPenPlanDecharge()

    Dim yearPath As String
    Dim weekFolder As String
    Dim filePath As String
    Dim wb As Workbook
    Dim currentYear As String
    Dim currentWeek As String
    Dim derniere_ligne As Long

    'Ouverture du plan de charge
    currentYear = Year(Date)
    currentWeek = "S" & Format(Application.WorksheetFunction.WeekNum(Date, vbMonday), "00")

    yearPath = "G:\DONNEES PRIVEES\PCHRG Ateliers\D150\" & currentYear & "\"
    weekFolder = Dir(yearPath & currentWeek, vbDirectory)

    If weekFolder = "" Then
        MsgBox "Le dossier pour la semaine " & currentWeek & " n'existe pas dans " & yearPath
        Exit Sub
    End If

    filePath = yearPath & weekFolder & "\Plan de Charge.xlsm"

    If Dir(filePath) = "" Then
        MsgBox "Le fichier 'Plan de Charge.xlsm' n'existe pas dans " & yearPath & weekFolder
        Exit Sub
    End If

    Set wb = Workbooks.Open(filePath)

    Windows("STZ.xlsm").Activate
    Sheets("Plan de charge").Select

    'Supprimer données de la feuille plan de charge du jour
    Cells.Delete Shift:=xlUp
    Windows("Plan de Charge.xlsm").Activate

    'Supprimer les filtres
    Selection.AutoFilter
    Columns("K:O").Select
    Selection.EntireColumn.Hidden = False

    derniere_ligne = Range("A1048576").End(xlUp).Row

    'Copier du plan de charge
    Range("B5:AG" & derniere_ligne).Copy
    Windows("STZ.xlsm").Activate

    'Coller du plan de charge
    Range("A3").Select
    ActiveSheet.Paste

    'Fermer plan de charge
    Windows("Plan de Charge.xlsm").Activate
    ActiveWindow.Close

    'Rajout d'une colonne sélection STZ
    Range("AI2").Value = "STZ"
    Range("AG3").Value = "STZ"
    Range("AG4").FormulaR1C1 = "=IF(R2C35=RC[-24],1,0)"
    Range("AG4").AutoFill Destination:=Range("AG4:AG" & derniere_ligne)

    'supp

    'Rajout d'une case à côté du plan de charge afin d'obtenir le retard J-J
    Sheets("Plan de charge").Select
    Range("AE853").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Retard "
    Range("AF853").Select
    ActiveCell.FormulaR1C1 = "= SUBTOTAL(109,R[-849]C:R[-103]C)"

    'Liaison avec bilans
    Sheets("Bilan").Select
    Range("C1").FormulaR1C1 = "=TODAY()"
    Range("C22").ClearContents
    Range("C22").FormulaR1C1 = "='Plan de charge'!R[831]C[29]"

End Sub

Sub supp()

    Dim cel_vide As Range
    Dim ad_cel As Integer

    For Each cel_vide In Range("AG4:AG6000")
        If cel_vide.Value <> 1 Then
            ad_cel = cel_vide.Row
            Rows(ad_cel).Delete
        End If
    Next cel_vide

End Sub

Bonjour,

Pourquoi vouloir utiliser VBA plutôt que les filtres Excel toujours plus rapide

Bonjour la fin de ton code devrait t'y aider

Sub supp()

Dim cel_vide As Range
Dim ad_cel As Integer

For Each cel_vide In Range("C4:C6000")
If cel_vide.Value <> 1 Then
ad_cel = cel_vide.Row
Rows(ad_cel).Delete
End If
Next cel_vide

End Sub

@ghisnob

Désolé, mais pour moi votre code est faux

Vous loupez forcément des lignes avec votre code... suppression de la ligne 1, la ligne 5 devient la 4

La suppression de ligne ce fait toujours de la fin vers le début

A+

@jExceL2fr

Même si j'y ai pas trop regardé, en relisant je me dis que ca à l'air d'être bon maintenant c'est possible que ca soit pas le cas j'attendrai peut être une autre proposition peut être la votre qui sait.

et si c'est qu'il faut le faire de la fin vers le début la boucle inversée :

for i= 6000 to 4 step -1

if range("C" & i).Value <> 1 Then
ad_cel = range("C" & i).Row
Rows(ad_cel).Delete
End If

Next

Ps : je me dis que les deux devraient marcher pareil, mais bon j'attendrai d'autre proposition

Bon weekend à tous

Bonsoir,

@ghisnob

La petite remarque émise par JExecl2fr était tout à fait de bon aloi.

Une suppression conditionnelle de lignes par VBA se fait toujours du bas vers le haut SAUF si l'index est remis à sa valeur lors de l'action.

Donc, si i=5, et que la ligne 5 est supprimée, il faut alors remettre i à 5 (donc Rows(i).Delete : i=i-1), afin que la ligne suivante soit examinée - autrement, on passe systématiquement à la ligne 7, la ligne 6 étant devenue ligne 5.

Vous propose de faire votre test (sur 10 lignes, ça suffira...), et de mettre 2 lignes successives répondant au test de suppression.

Vous verrez de suite le problème

Bonne soirée

bonsoir @cousinhub

Merci pour la confirmation de la remarque @jExceL2fr, prochainement je saurai.

Merci à vous

En suivant les explications de @cousinhub et les remarques @jExceL2fr

le code à utiliser, le i=6000 peut etre changé par un :

dans les déclarations: dim nbligne as integer

affectation du numero de la derniere ligne: nbligne = Cells(Rows.Count, 1).End(xlUp).Row

For i=nbligne to 4 step -1

if range("C" & i).value <> 1 Then ou if range("C" & i).value =0 Then

Code qui peut etre modifié avec la partie en bleu

Sub supp()
Dim cel_vide As Range
Dim ad_cel As Integer
For i = 6000 To 4 Step -1

If Range("C" & i).Value <> 1 Then
ad_cel = Range("C" & i).Row
Rows(ad_cel).Delete
End If

Next

End Sub

Bonsoir à tous,

Une méthode plus rapide que la suppression ligne par ligne :

Sub supprBloc()
Dim t, i&, deb
   deb = Timer: Sheets("Tri et un seul bloc").Select
   Application.ScreenUpdating = False
   t = Range("ag4:ag6000")
   For i = 1 To UBound(t): t(i, 1) = IIf(t(i, 1) <> 1, Empty, 1): Next
   Range("ag4:ag6000") = t
   Rows("4:6000").Sort key1:=Range("ag4"), order1:=xlAscending, Header:=xlNo
   On Error Resume Next
   Range("ag4:ag6000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   MsgBox "Durée = " & Format(Timer - deb, "# ##0.00 \sec.")
End Sub

Voir le fichier joint qui compare les deux méthodes. Cliquer sur le bouton dans chacune des deux premières feuilles.

Sur ma bécane :

• ligne par ligne : environ 2 s
• par bloc : environ 0,05 s
  4camv-ol-suppr-lignes-sous-condition-v1.xlsm (243.36 Ko)

Bonsoir @mafraise

méthode excellente que j'utiliserais à l'avenir

Merci

Re ghisnob ,

Cette méthode est en fait "réduite" par rapport à la méthode générale. Dans le cas traité, on ne garde que les cellules qui ont toutes la même valeur unique 1 en colonne AG. Donc lorsqu'on effectue le tri sur cette colonne, l'ordre relatif des lignes comportant un 1 n'est n'est pas modifié (le tri Excel est un tri stable). Il suffit de supprimer le bloc des lignes vides.

Mais si par exemple la colonne AG comportait les valeurs 0 ou 1 ou 2 ou 3, le tri modifierait l'ordre relatif des lignes qu'on conserve : on aurait d'abord le bloc des lignes comportant un 1 puis le bloc des lignes comportant un 2 puis le bloc des lignes comportant un 3. On aurait perdu l'ordre relatif initial des lignes conservées.

Une méthode consiste à insérer une colonne auxiliaire, à la remplir par le numéro de la ligne si la ligne est à conserver ou bien vider la cellule si la ligne est à supprimer. On trie ensuite le tableau selon cette colonne auxiliaire. On supprime les lignes du bloc des cellules vides. Et ensuite on refait un tri sur la colonne auxiliaire qui va redonner aux lignes conservées leurs positions relatives (c'est pour ça qu'on avait mis le numéro de ligne pour les lignes à conserver). On termine en supprimant la colonne auxiliaire. Ce processus est un peu plus long puisqu'on insère et supprime une colonne, et on fait deux tris au lieu d'un seul.

nota : Un tri est dit stable s'il préserve l’ordonnancement initial des éléments que l'ordre considère comme égaux.

Bonjour mafraise

J'avais pas pensé au cas où AG aurait plusieurs valeurs je me disais qu'il fallait juste jouer sur le SI avec une condition = 0, mais comme tu l'as expliqué le tri aurait changé l'ordre.

Tant qu'on peut réduire le temps de calcul c'est un grand avantage

Bonjour à tous !

Merci pour votre aide !

Malheureusement je n'arrive toujours pas à supprimer les lignes que je veux.

L'erreur qui s'affiche est "Incompatibilité de type". Pourtant ma colonne AG a pour format de cellule "Standard".

Bonjour,

Avec le fichier ce serait plus facile de vous aider

Bonjour à tous

Comme l'a dit JExcel2fr, il faudra mettre votre fichier, pour moi à la base ce n'était pas la colonne AG mais plutot C

Je vous ai mis à disposition un fichier exemple dans mon tout premier message !

Le revoici :

ghisnob votre suppression de ligne dans votre fichier type ne fonctionne pas ....

Dans le fichier que vous ai joint précédemment, en effet ça serait plutôt la colonne C à filtrer.

Dans mon réel fichier que je ne peux vous joindre je dois filtrer la colonne AG.

vous pouvez vous aider de la proposition de mafraise

Bonjour à tous ,

Le code que j'ai déjà publié doit le faire. J'avais considéré que l 0 et les 1 de la colonne AG étaient des constantes or à priori ce sont des formules.

Si à la fin de traitement, on veut conserver les formules (donc celles qui renvoient 1) sans les avoir transformées en constantes, utilisez le code ci-dessous :

Sub supprBlocFormules()
Dim t, f, i&, deb
   deb = Timer: Sheets("Feuil1").Select
   Application.ScreenUpdating = False
   t = Range("ag4:ag6000"): f = Range("ag4:ag6000").Formula
   For i = 1 To UBound(t): t(i, 1) = IIf(t(i, 1) <> 1, Empty, f(i, 1)): Next
   Range("ag4:ag6000").Formula = t
   Rows("4:6000").Sort key1:=Range("ag4"), order1:=xlAscending, Header:=xlNo
   On Error Resume Next
   Range("ag4:ag6000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   MsgBox "Durée = " & Format(Timer - deb, "# ##0.00 \sec.")
End Sub

Bonjour,

J'ai testé tout les codes que vous m'avez proposé, à chaque fois j'ai l'erreur "Incompatibilité de type" .

Je vous ai directement mis le fichier sur lequel je travail, dans la colonne AG, j'ai soit 1, soit 0, soit N/A, j'aimerais garder seulement les lignes qui ont 1.

Pour être plus claire, j'obtiens cette colonne en faisant une comparaison entre chaque cellule de la colonne I et la cellule AI2.