supprimer des lignes vides

murainesouspatate · 22 Février 2013

Bonjour à tous les copains,

Me revoici car j'ai un petit problème sur une ligne de commande qui ne passe pas et étant novice dans le domaine , je n'arrive pas à comprendre pourquoi. 😕

Cette macro devrais me permettre de supprimer des lignes vides d'un fichier contenant environ 33500 lignes.

ci joints la macro :

Dim Compteur As Long, Compteur2 As Long, Compteur3 As Integer
Dim Tab_Donnees As Variant, Tab_Donnees2 As Variant
Dim Der_Cel As Range

Set Der_Cel = ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell)
ReDim Tab_Donnees(1 To Der_Cel.Row, 1 To Der_Cel.Column)
Tab_Donnees2 = ActiveSheet.Range("A1:" & Der_Cel.Address).Value
Compteur2 = 0

For Compteur = 1 To Der_Cel.Row
If Not Application.CountA(ActiveSheet.Rows(Compteur)) = 0 Then
Compteur2 = Compteur2 + 1
For Compteur3 = 1 To Der_Cel.Column
Tab_Donnees(Compteur2, Compteur3) = Tab_Donnees2(Compteur, Compteur3)
Next Compteur3
End If
Next Compteur
ActiveSheet.Range("A1:" & Der_Cel.Address).Value = Tab_Donnees (c'est cette ligne qui bogue)

End Sub

Si vous pouviez m'expliquer, merci de votre part pour ce petit coup de pouce.

A très bientôt..... pour de nouvelles aventures ! 😎

MINO · 22 Février 2013

Re : supprimer des lignes vides

Hallo
si j ai b1copmris ,tu v un macro pour supprime les lignes vides
ci joint un macro plus simple mais efficace

Sub Delet_Range()
Dim i As Long

For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Application.CountA(Rows(i)) = 0 Then Rows(i).Delete
Next i

End Sub

murainesouspatate · 22 Février 2013

Re : supprimer des lignes vides

merci, mais elle n'est pas assez rapide , environ 20 min.
j'aurais aimé que l'on m'explique ou je merdouille....

à très bientôt......

grisan29 · 22 Février 2013

Re : supprimer des lignes vides

bonjour

voici un code qui est issu du fichier facturation que Jean Paul VIARD a mis en téléchargement,professionnel, gestion commerciale

Code:

Sub SupLig_Vides() 'Traitement lignes vides et format
Dim Lp%, Lv%, Lg% 'auteur JPV
Dim X%, Nb%

Sheets("Feuil1").Activate
Application.ScreenUpdating = False
'------------------- Initialisation -----------------------------
Nb = Sheets("Feuil1").Range("A7").Value
If Nb = 0 Then Exit Sub
If Nb = 33 Then Exit Sub
Lp = 0 'compteur lignes pleines
Lv = 0 'compteur lignes vides
Lg = 11 'ligne de départ du traitement

'--------------- Suppression des cellules vides qq soient leurs nombres ------------
Do While Lp <= Nb - 1
    If Cells(Lg + Lp + Lv, 1).Value = "" Then
        Lv = Lv + 1
        ElseIf Cells(Lg + Lp + Lv, 1).Value <> "" And Lv >= 1 Then
            For X = 0 To 3
                Cells(Lg + Lp, 1).Offset(0, X).Font.Name = Cells(Lg + Lp, 1).Offset(Lv, X).Font.Name
                Cells(Lg + Lp, 1).Offset(0, X).Font.Size = Cells(Lg + Lp, 1).Offset(Lv, X).Font.Size
                Cells(Lg + Lp, 1).Offset(0, X).Font.Bold = Cells(Lg + Lp, 1).Offset(Lv, X).Font.Bold
                Cells(Lg + Lp, 1).Offset(0, X).Font.Color = Cells(Lg + Lp, 1).Offset(Lv, X).Font.Color
                Cells(Lg + Lp, 1).Offset(0, X) = Cells(Lg + Lp, 1).Offset(Lv, X).Value
                Cells(Lg + Lp, 1).Offset(Lv, X).Value = ""
            Next
        Lp = Lp + 1
        Lv = 0
    Else
        Lp = Lp + 1
    End If
Loop
Sheets("Feuil1").Range("I2").Value = 1
Application.ScreenUpdating = True
End Sub

si cela peut faire votre affaire

Pascal

mapomme · 23 Février 2013

Re : supprimer des lignes vides

Bonjour murainesouspatate, Mino, grisan29, le forum,

J'ai modifié deux lignes dans votre code qui à l'air de fonctionner chez moi dans un fichier de mon cru puisqu'aucun fichier n'a été joint par vos soins.

J'en ai aussi profité pour installer le code de MINO.

Votre code est le plus rapide des deux puisque vous utilisez un tableau pour stocker le résultat. mais il ne conserve pas les mises en forme.

Sur ma vieille machine: votre code => # 3,40s, le code de MINO => # 35,60s.

Votre code modifié:

VB:

Sub Supprimer_MSP_1()   'murainesouspatate
Dim Compteur As Long, Compteur2 As Long, Compteur3 As Integer
Dim Tab_Donnees As Variant, Tab_Donnees2 As Variant, T1
Dim Der_Cel As Range

  T1 = Timer
  Application.ScreenUpdating = False
With Sheets("Feuil1")
  Set Der_Cel = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)    '**** modif
  ReDim Tab_Donnees(1 To Der_Cel.Row, 1 To Der_Cel.Column)
  Tab_Donnees2 = ActiveSheet.Range("A1:" & Der_Cel.Address).Value
  Compteur2 = 0

  For Compteur = 1 To Der_Cel.Row
    If Not Application.CountA(ActiveSheet.Rows(Compteur)) = 0 Then
      Compteur2 = Compteur2 + 1
      For Compteur3 = 1 To Der_Cel.Column
        Tab_Donnees(Compteur2, Compteur3) = Tab_Donnees2(Compteur, Compteur3)
      Next Compteur3
    End If
  Next Compteur
  '**** ligne modifiée pour adapter la zone cible aux dimensions de Tab_Donnees
  .Range("A1").Resize(UBound(Tab_Donnees, 1) - LBound(Tab_Donnees, 1) + 1, _
    UBound(Tab_Donnees, 2) - LBound(Tab_Donnees, 2) + 1) = Tab_Donnees
End With
  Application.ScreenUpdating = True
  MsgBox "Traitement terminé. Durée= " & Format(Timer - T1, "#0.00") & "s"
End Sub

job75 · 23 Février 2013

Re : supprimer des lignes vides

Bonjour à tous,

Avec l'entrée d'une formule et un simple tri cette macro doit être très rapide non ?

Code:

Sub SupprimeLignesVides()
Dim col As Integer
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
  col = .Columns.Count + 1
  .Columns(col).FormulaR1C1 = "=COUNTA(RC1:RC[-1])=0"
  .Resize(, col).Sort .Columns(col), xlAscending, Header:=xlNo
  .Columns(col).ClearContents
End With
End Sub

A+

job75 · 23 Février 2013

Re : supprimer des lignes vides

Re,

En ne gardant que les valeurs renvoyées par les formules, la macro est plus rapide :

Code:

Sub SupprimeLignesVides()
Dim col As Integer
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
  col = .Columns.Count + 1
  .Columns(col).FormulaR1C1 = "=COUNTA(RC1:RC[-1])=0"
  .Columns(col) = .Columns(col).Value 'ne garde que les valeurs
  .Resize(, col).Sort .Columns(col), xlAscending, Header:=xlNo
  .Columns(col).ClearContents
End With
End Sub

A+

murainesouspatate · 23 Février 2013

Re : supprimer des lignes vides

Bonjour, l'idée de départ est de supprimer les lignes et colonnes vides assez rapidement ( - de 20 min.), je n'arrive pas a descendre en dessous même en désactivant l'affichage écran et le calcul automatique pour gagner en rapidité.
Mon fichier zippé fait 800 Ko, je ne sais pas comment le rajouter ou vous le faire parvenir.

Cordialement.

néné06 · 23 Février 2013

Re : supprimer des lignes vides

Bonjour à tous

Comme te l,indique notre ami Job 75,avec les tries cette routine ne doit pas durée plus de deux secondes

À+

Rene

murainesouspatate · 23 Février 2013

Re : supprimer des lignes vides

je suis désolé mais la routine ne fonctionne pas , j'ai toujours des lignes vides , je suis sous excel 2007.

mapomme · 23 Février 2013

Re : supprimer des lignes vides

Bonjour à tous,

J'ai rajouté la procédure de job75. Sur ma bécane, elle se situe en durée d'exécution entre celle de murainesouspatate et celle de MINO. La réinitialisation est un peu plus longue mais la taille du fichier est réduite.

néné06 à dit:
avec les tries cette routine ne doit pas durée plus de deux secondes

Inférieur à 2s ==> Ma machine se fait vieille! Mais je l'aime bien quand même 🙂 )

nb:

murainesouspatate à dit:
Mon fichier zippé fait 800 Ko, je ne sais pas comment le rajouter ou vous le faire parvenir.

N'envoyer qu'un extrait de votre fichier (solution de loin la meilleure) ou bien déposer le fichier sur le site "Cjoint.com" puis indiquez nous l'adresse.
Ôtez de votre fichier les données nominatives ou confidentielles.

Pour joindre un fichier:
Quand vous rédigez un nouveau message ou quand vous modifiez un de vos messages, passez en mode avancé et cliquez sur 'Gérer les pièces jointes' ou bien cliquez directement sur l'icone 'Trombone'.
Choisissez vos fichiers (boutons Choisir un fichier), cliquez sur envoyer (bouton envoyer) pour les charger, quand ils sont chargés (les noms des fichiers s'affichent en couleur) refermez la fenêtre (bouton Fermer cette fenêtre) puis cliquez sur 'envoyez...' ou 'enregistrer les changements'.

murainesouspatate · 23 Février 2013

Re : supprimer des lignes vides

voici le lien du fichier concerné ! la mise en forme doit être conservée.

http://cjoint.com/?CBxlUkUChlf

record à battre 20min.
Cordialement.

job75 · 23 Février 2013

Re : supprimer des lignes vides

Re,

murainesouspatate à dit:
je suis désolé mais la routine ne fonctionne pas , j'ai toujours des lignes vides , je suis sous excel 2007.

C'est sans doute que ces lignes contiennent des textes vides "".

Alors essayez ceci :

Code:

Sub SupprimeLignesVides()
Dim col As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ActiveSheet.UsedRange
  col = .Columns.Count + 1
  .Columns(col).FormulaR1C1 = "=COUNTIF(RC1:RC[-1],""><"")+COUNT(RC1:RC[-1])=0"
  .Columns(col) = .Columns(col).Value 'ne garde que les valeurs
  .Resize(, col).Sort .Columns(col), xlAscending, Header:=xlNo
  .Columns(col).ClearContents
End With
Application.Calculation = xlCalculationAutomatic
End Sub

Nota : s'il y a des valeurs d'erreur ou des valeurs logiques elles ne seront pas comptées.

A+

mapomme · 23 Février 2013

Re : supprimer des lignes vides

Bonjour à tous,

Une explication ?:

Votre zone de données comporte des cellules fusionnées.

Un certain nombre (non négligeable) d'opérations aboutissent à un échec en cas de présence de cellules fusionnées.

Evitez & fuyez les les cellules fusionnées! (c'est mon opinion et je la partage! 🙄 )

murainesouspatate · 23 Février 2013

Re : supprimer des lignes vides

Bonjour,

c'est une extraction brute d'un logiciel en ligne de métrologie qui me sert une fois remis en forme de base access.

Effectuez une recherche sur Excel Downloads...

supprimer des lignes vides

murainesouspatate

XLDnaute Occasionnel

MINO

XLDnaute Junior

murainesouspatate

XLDnaute Occasionnel

grisan29

XLDnaute Accro

mapomme

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

murainesouspatate

XLDnaute Occasionnel

néné06

XLDnaute Accro

murainesouspatate

XLDnaute Occasionnel

mapomme

XLDnaute Barbatruc

Pièces jointes

murainesouspatate

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

murainesouspatate

XLDnaute Occasionnel

Discussions similaires

Nous accordons de l'importance à votre vie privée