Supprimer lignes SI toute la ligne vides SAUF col.A

Le 30/07/2018 à 15:36

Bonjour à tous,

Cela fait un moment que je lis le forum en mode anonyme

Plus qu'utile, j'ai pu grâce au cours et aux différents sujets, effectuer mes premières manipulations de VBA.

Mais aujourd'hui, je viens vers vous car je ne trouve pas la solution à un problème qui m'embête beaucoup...

La base :

J'ai 2 fichiers : un esclave et un maître.

Le fichier esclave est lu par un logiciel et ne doit donc comporter aucune formule dans ces petites cases.

Le fichier maître me permet d'ajouter des catégories (colonne), des références (lignes) dans le fichier esclave et puis surtout mettre des 1 ou des " " (vide ^^) dans toutes la plage de données.

Du coup dans mon fichier esclave (celui qui m'intéresse de traiter), j'ai sur une ligne parfois juste un seul 1 en face d'une colonne ou alors plusieurs si ma référence rentrent dans plusieurs catégories.

Un peu plus de détails :

Dans mon fichier maître, j'ai des boutons et des champs, qui vont me permettre de créer des catégories, les alimenter, les modifiers et les supprimer.

En voilà que mon problème approche à grand pas..

Par exemple, je décide que ma référence n'est plus utile dans une catégorie. J'utilise ma macro pour enlever le 1 dans la plage de données. (OK jusqu'ici). Mais, j'aimerai aussi que cette macro vérifie toutes mes lignes et trouver maintenant celles qui ne sont utilisés pour les supprimer.

Un peu moins de détails :

Je voudrais que le code VBA supprime les lignes :

  • dont les colonnes B, C, D, E, F, G, H, x................ sont vides (il n'y a pas de limites au niveau du nombre de colonnes)
  • Biensûr la macro devra remonter ligne par ligne mais aussi colonne par colonne. Pour être sûr qu'ils prennent toutes les colonnes et toutes les lignes.

Le code actuel :

Sub Test ()

    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        If Cells(i, 2) = "" And Cells(i, 3) = "" And Cells(i, 4) = "" And Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" And Cells(i, 13) = "" And Cells(i, 14) = "" And Cells(i, 15) = "" And Cells(i, 16) = "" And Cells(i, 17) = "" And Cells(i, 18) = "" And Cells(i, 19) = "" And Cells(i, 20) = "" And Cells(i, 21) = "" And Cells(i, 22) = "" And Cells(i, 23) = "" And Cells(i, 24) = "" And Cells(i, 25) = "" And Cells(i, 26) = "" And Cells(i, 27) = "" And Cells(i, 28) = "" And Cells(i, 29) = "" And Cells(i, 30) = "" And Cells(i, 31) = "" And Cells(i, 32) = "" And Cells(i, 33) = "" And Cells(i, 34) = "" And Cells(i, 35) = "" And Cells(i, 36) = "" And Cells(i, 37) = "" And Cells(i, 38) = "" And Cells(i, 39) = "" And Cells(i, 40) = "" And Cells(i, 41) = "" And Cells(i, 42) = "" And Cells(i, 43) = "" And Cells(i, 44) = "" And Cells(i, 45) = "" And Cells(i, 46) = "" And Cells(i, 47) = "" Then
            Rows(i).EntireRow.delete
        End If
    Next i

End Sub

Ce code fonctionne super bien ! Sauf que je peux pas aller plus loin que la colonne 47. Et ça c'est mon soucis. Aujourd'hui j'ai 30 colonnes, demain j'en aurai 60...

J'aimerai savoir si l'un d'entre vous aurait une solution pour éviter que je me retrouve embêter quand je serai arriver à la colonne 48.

Merci à vous les experts !

Je reste dispo quasi à l'instantanée si vous avez besoin de plus de détails sur mon histoire

Le 30/07/2018 à 15:41

Bonjour,

Il serait plus judicieux de créer une boucle pour parcourir les colonne. Tant qu'elles sont vides, tu continus la boucle, sinon tu places un "Exit For". Si ta macro arrives à la dernière colonne, c'est qu'elle n'a rencontré aucune valeur et donc que la ligne peut être supprimée...

Par exemple :

Sub Test ()

    Dim i As Long, i2 As Byte
    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        For i2 = 2 To ActiveSheet.UsedRange.Columns.count
            If Not IsEmpty(Cells(i, i2)) Then Exit For
            If i2 = ActiveSheet.UsedRange.Columns.count Then Rows(i).EntireRow.delete
        Next i2
    Next i

End Sub
Le 30/07/2018 à 15:58
Sub delete_content()
' Action by button

    Dim Nom As String
    Dim MaFeuille As Worksheet
    Set MaFeuille = Sheets("Research")
    Cat = Sheets("Research").Range("F33").Value

Sheets("Research").Select
Range("F36:F55").Select
    Selection.Copy

Sheets(Cat).Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Dim i As Integer, j As Integer

Application.ScreenUpdating = False

For i = 1 To 1000
    On Error Resume Next
    j = Application.WorksheetFunction.Match(Range("A" & i), Range("B:B"), 0)
    If j > 0 Then
        Range("A" & i) = ""
    End If
    j = 0
Next

For i = 1 To 1000
    If Range("A" & i) = "" Then Rows(i).EntireRow.delete
Next

Range("B:B").ClearContents

Windows("flags.xlsx").Activate
Sheets("concept_flags").Select

    Range("B2").Select
        ActiveCell.FormulaR1C1 = _
                 "=IF(ISERROR(VLOOKUP(RC1,INDIRECT(""'P:\_Departments\MBA\PROJETS_TECH\FRED projets tech\Flags\[Input_concept.xlsm]"" & R1C & ""'!$a$1:$a$1000""),1,0)),"""",1)"
    Selection.Copy
    ' Copy-Paste the formula in the first cell

 Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:DA2"), Type:=xlFillDefault

    [b]Dim i As Long[/b], plage As Range
    i = Range("A" & Rows.Count).End(xlUp).Row
    Set plage = Range("B2:DA2")
    plage.AutoFill Destination:=Range("B2:DA" & i), Type:=xlFillDefault4
    'Copy-Paste the formula to down

    Range("B2:DA2000").Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Delete formula and put text

   [b] Dim i As Long[/b], Dim i2 As Byte
    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        For i2 = 2 To Cells(1, Columns.Count).End(xlToLeft).column
            If Not IsEmpty(Cells(i, i2)) Then Exit For
            If i2 = Cells(1, Columns.Count).End(xlToLeft).column Then Rows(i).EntireRow.delete
        Next i2
    Next i

End Sub

Je viens de tester cela ne fonctionne pas... 100% de ma faute je pense

Je pense que j'ai fais les choses de travers, sa ne fonctionne pas et me dit : "Déclaration existante dans la portée en cours".

Si je ne m'abuse, j'ai commis une erreur en mettant "i" en Dim plusieurs fois et surtout juste avant j'ai déjà "Dim i As Long"

Je dois replacer toutes mes déclarations de variables au tout départ, nommer mes variables de la même façon et surtout les écrire qu'une fois. C'est bien ça ?

Le 30/07/2018 à 16:00

Bonjour,

Simplement :

Sub Test()
Dim i As Long
    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        If Cells(i, "a").End(xlToRight).Column = Columns.Count Then Rows(i).EntireRow.Delete
    Next i
End Sub
Le 30/07/2018 à 16:02

Bon, y'a un peu de travail. Peux-tu envoyer un fichier ET commenter un peu ton code, que je comprenne mieux ce que tu essaies de faire...

Le 30/07/2018 à 16:04
Patrice33740 a écrit :

Bonjour,

Simplement :

Sub Test()
Dim i As Long
    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        If Cells(i, "a").End(xlToRight).Column = Columns.Count Then Rows(i).EntireRow.Delete
    Next i
End Sub

Bonjour @Patrice33740, je dis peut-être une bêtise (sans doute même), mais si il y a quelque chose dans la dernière colonne, ton code supprimera quand même la ligne ?

Le 30/07/2018 à 16:06

Je te remercie de ton aide

Le fichier est remplit de données personnelles, je vais anomyser tout ça et le réduire surtout. Puis t'envoyer avec le code expliqué

Le 30/07/2018 à 16:09

Bonjour,

Une variante :

Sub Test3()
Dim i, X As Long
Dim Cl As Range

With ActiveSheet
    Application.ScreenUpdating = False
    X = Columns.Count
    For i = .Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        y = 0
        For Each Cl In Range(.Cells(i, 2), .Cells(i, X))
            If Cl <> "" Then y = y + 1
        Next Cl
        If y = 0 Then Rows(i).EntireRow.Delete
    Next i
End With
End Sub

ric

Le 30/07/2018 à 16:13
Pedro22 a écrit :

Bonjour @Patrice33740, c'est peut-être une bêtise (sans doute même), mais si il y a quelque chose dans la dernière colonne, ton code supprimera quand même la ligne ?

Et crois-tu que dans ce cas (très peu probable) ta ligne fonctionnerait mieux ? :

 For i2 = 2 To Cells(1, Columns.Count).End(xlToLeft).Column

EDIT, la solution à ce problème :

Sub Test()
Dim i As Long
    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        If Cells(i, "A").EntireRow.Find("*").Column = 1 Then Rows(i).EntireRow.Delete
    Next i
End Sub
Le 30/07/2018 à 16:20

Le temps que j'arrange le fichier, je vous tiens au courant.

J'ai remis toutes mes Déclaration de variable en haut, je les ai tous renommer différement. Donc là, plus d'erreur.

Par contre, ma macro supprime le 1 qui est dans la ligne juste avant.

Du coup ligne vide, mais aucune suppression de celle-ci.

Je suis toujours entrain de bidouiller pour vous envoyer le fichier.

Le 30/07/2018 à 16:34
Patrice33740 a écrit :

Et crois-tu que dans ce cas (très peu probable) ta ligne fonctionnerait mieux ? :

 For i2 = 2 To Cells(1, Columns.Count).End(xlToLeft).Column

Le seul problème avec cette instruction, et je viens de m'en rendre compte, c'est dans le cas où il n'y a des données qu'en colonne A. J'ai donc modifié ma proposition pour utiliser "UsedRange.Columns.Count"

Ma remarque était juste pour souligner que dans ton code, sauf erreur de ma part, tu cherches la première colonne contenant des données, et que si ça t'envoies en dernière colonne, tu supprimes la ligne. Sauf qu'il peut y avoir une donnée dans cette colonne.

Le 30/07/2018 à 16:40

Fichier trop volumineux : 2,3 mo.

Avez-vous une autre solution pour transférer les fichiers ?

Je vous remet le code modifié et commenté :

Sub delete_content()
' Action by button

    Dim Nom As String
    Dim MaFeuille As Worksheet
    Dim i As Integer, j As Integer
    Dim k As Long, plage As Range
    Dim l As Long
    Set MaFeuille = Sheets("Research")
    Cat = Sheets("Research").Range("F33").Value
' Je déclare tout ici 

Sheets("Research").Select
Range("F36:F55").Select
    Selection.Copy
' Je copie les références que je veux supprimer de ma catégorie

Sheets(Cat).Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' Je colle ses références dans l'onglet (même classeur), pour comparer avec ceux qui sont déjà là.

Application.ScreenUpdating = False
For i = 1 To 1000
    On Error Resume Next
    j = Application.WorksheetFunction.Match(Range("A" & i), Range("B:B"), 0)
    If j > 0 Then
        Range("A" & i) = ""
    End If
    j = 0
Next

For i = 1 To 1000
    If Range("A" & i) = "" Then Rows(i).EntireRow.delete
Next

Range("B:B").ClearContents
' Je compare la colonne A (les références présentes de base) avec la colonne B (les références à supprimer), Je fait le tri et je supprime les références à enlever et la colonne B

Windows("flags.xlsx").Activate
Sheets("concept_flags").Select
    Range("B2").Select
        ActiveCell.FormulaR1C1 = _
                 "=IF(ISERROR(VLOOKUP(RC1,INDIRECT(""'P:\_Departments\MBA\PROJETS_TECH\FRED projets tech\Flags\[Input_concept.xlsm]"" & R1C & ""'!$a$1:$a$1000""),1,0)),"""",1)"
    Selection.Copy
 ' Je passe dans mon autre fichier, et colle ma formule avec variable en B2

 Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:DA2"), Type:=xlFillDefault

    k = Range("A" & Rows.Count).End(xlUp).Row
    Set plage = Range("B2:DA2")
    plage.AutoFill Destination:=Range("B2:DA" & k), Type:=xlFillDefault4
    'Copy-Paste the formula to down
  ' Je l'étend partout

    Range("B2:DA2000").Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Je copie colle les données et les colles juste avec la valeurs, j'enlève la formule. Pour que le fichier soit figé jusqu'à la prochaine modification et surtout pour que notre logiciel puisse lire les données

    For l = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        If Cells(l, "A").EntireRow.Find("*").Column = 1 Then Rows(l).EntireRow.Delete
    Next l
' J'ai testé toutes les formules

End Sub

Je sais pas si c'est plus clair avec les explications

Le 30/07/2018 à 16:44
Dyjor91240 a écrit :

Le temps que j'arrange le fichier, je vous tiens au courant.

J'ai remis toutes mes Déclaration de variable en haut, je les ai tous renommer différement. Donc là, plus d'erreur.

Par contre, ma macro supprime le 1 qui est dans la ligne juste avant.

Du coup ligne vide, mais aucune suppression de celle-ci.

Je suis toujours entrain de bidouiller pour vous envoyer le fichier.

Quelques remarques sur ton code :

  • -> La majorité des ".Activate" et ".Select" sont inutiles. La plupart du temps, les instructions du type "Bidule.Select" et "Selection.Copy" peuvent s'écrire en 1 ligne tel que "Bidule.Copy".
  • -> Quand tu déclares des objets, tel qu'une feuille : "Set MaFeuille = Sheets("Research")", utilises cet objet par la suite plutôt que de réecrire plus loin "Sheets("Research").Range(..."
  • -> Quand tu utilises plusieurs fois le même objet : "MaFeuille.Range(A1)..." tu peux écrire :
With MaFeuille
    .Range(A1)
    .Range(B1)
    '...
End With

--> Quand tu manipules plusieurs onglets et/ou plusieurs fichiers différents, préciser la référence de chaque objet :

Set MonFichier = Workbook("Fichier.xlsx")
Set MaFeuille = MonFichier.Sheets("Research")
MaFeuille.Range("A1") = ...
Le 30/07/2018 à 16:47

Je note toutes ces remarques, j'ai de quoi simplifié mon code déjà..

Je vais tenter de m'y attaquer dans tous ce que j'ai déjà fait

Par contre c'est vrai que tout le reste fonctionne, mon début de macro (même si moche) fait le travaille. C'est vraiment la suppression des lignes qui veut pas.

Le 30/07/2018 à 16:50
Dyjor91240 a écrit :

Je note toutes ces remarques, j'ai de quoi simplifié mon code déjà..

Je vais tenter de m'y attaquer dans tous ce que j'ai déjà fait

Par contre c'est vrai que tout le reste fonctionne, mon début de macro (même si moche) fait le travaille. C'est vraiment la suppression des lignes qui veut pas.

Finalement, j'ai supprimer toutes les colonnes (catégorie) que j'avais déjà créer. J'ai recommencer avec des catégories tests, et ça à l'air de fonctionner maintenant...

A n'y rien comprendre.

Je vais remettre le fichier avec toutes mes catégories et je vous dirai si tout est bon. (Et si oui, je mettrai résolu )

Le 30/07/2018 à 16:57

J'ai modifié ton code au pied levé, mais déjà le fichier concerné par chaque instruction de ton code n'est pas très clair pour moi, à vérifier ce que j'ai fait donc...

Sub delete_content()
' Action by button
Application.ScreenUpdating = False

    Dim Nom As String, Cat As String
    Dim MaFeuille As Worksheet
    Dim i As Integer, j As Integer
    Dim k As Long, plage As Range
    Dim l As Long
    Set MaFeuille = Sheets("Research")

    Cat = MaFeuille.Range("F33").Value
' Je déclare tout ici

MaFeuille.Range("F36:F55").Copy
' Je copie les références que je veux supprimer de ma catégorie
With Sheets(Cat)
    .Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ' Je colle ses références dans l'onglet (même classeur), pour comparer avec ceux qui sont déjà là.

    For i = 1000 To 1 Step -1
        On Error Resume Next
        If Application.WorksheetFunction.Match(Range("A" & i), Range("B:B"), 0) > 0 Then
            .Range("A" & i) = ""
        Else: Rows(i).EntireRow.Delete
        End If
    Next i

    .Range("B:B").ClearContents
    ' Je compare la colonne A (les références présentes de base) avec la colonne B (les références à supprimer), Je fait le tri et je supprime les références à enlever et la colonne B
End With

With Windows("flags.xlsx").Sheets("concept_flags")

    k = .Range("A" & Rows.Count).End(xlUp).Row
    Set plage = .Range("B2:DA" & k)
        .Range("B2").FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC1,INDIRECT(""'P:\_Departments\MBA\PROJETS_TECH\FRED projets tech\Flags\[Input_concept.xlsm]"" & R1C & ""'!$a$1:$a$1000""),1,0)),"""",1)"
    .Range("B2").Copy plage
    plage.Copy
    .Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
     ' Je passe dans mon autre fichier, et colle ma formule avec variable en B2

    For l = .Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        If .Cells(l, "A").EntireRow.Find("*").Column = 1 Then Rows(l).EntireRow.Delete
    Next l
' J'ai testé toutes les formules
End With

Application.ScreenUpdating = True

End Sub
Le 30/07/2018 à 22:38

@Pedro22, c'était exactement ça.

Tout fonctionne correctement, et j'ai même pu en profiter pour modifier les autres macros que j'avais dans ce fichier

J'ai tout bien lu et je comprend mieux la subtilité du codage VBA.

Je cerne mieux le principe des variables, de l'inutilité des .Select à tout va et du référencement des objets.

Je t'avoue que mon niveau est encore bas, mais là tu m'as mis un bon coup de pouce qui me remet dans le droit chemin.

Un gros MERCI à vous tous !

Le 31/07/2018 à 00:15

Tu te rendras vite compte que mon niveau n'est pas très élevé non plus, mais c'est en pratiquant que l'on s'améliore !

PS: petite précision pour ton code, tu peux écrire directement le résultat d'une formule dans une cellule, plutôt que de dire à VBA d'écrire une formule Excel puis de la copier en valeur. Par contre, la syntaxe des formules VBA est différente puisque certaines existent directement dans VBA (IsEmpty(Range("A1")) équivalent de ESTVIDE(A1) par exemple) et d'autres sont propres à l'application Excel et doivent donc y faire référence (SOMME(A1:A5) s'écrit Application.Sum(Range("A1:A5"))... Dans ce cas on affecte directement le résultat dans une cellule, sans passer par l'instruction ".Formula".

Rechercher des sujets similaires à "supprimer lignes toute ligne vides sauf col"