Quel est le moyen le plus rapide de supprimer toutes les lignes vides d'un tableau Excel?

Question

Je vois plusieurs articles sur la suppression de lignes vides dans une plage et d'autres sur la suppression de lignes de tableau en fonction d'une seule colonne vide, mais rien sur la suppression de lignes de tableau entièrement vides.

Quel est le moyen le plus rapide de le faire?

J'ai posté ma solution ci-dessous pour aider les autres mais je suis intéressé de voir si quelqu'un a une méthode plus rapide.

Answer 1

Voici une procédure que j'utilise pour supprimer des lignes de tableau vides. Je travaille parfois avec de grands ensembles de données (pour Excel) et cette méthode est plus rapide. Il charge les lignes de table dans un tableau, vérifie les lignes vides dans le tableau et exécute une opération range.delete à la fin.

Vous utilisez la procédure comme ceci:

Sub Test() 
    DeleteBlankTableRows ActiveSheet.ListObjects(1) 
End Sub 

ActiveSheet.ListObjects (1) est (généralement) la première table de table sur la feuille de calcul active.

est ici la procédure actuelle:

Sub DeleteBlankTableRows(ByVal tbl As ListObject) 
    Dim rng As Range 
    Set rng = tbl.DataBodyRange ' Get table data rows range. 
    Dim DirArray As Variant 
    DirArray = rng.Value2  ' Save table values to array. 

    ' LOOP THROUGH ARRAY OF TABLE VALUES 
    Dim rowTMP As Long 
    Dim colTMP As Long 
    Dim combinedTMP As String 
    Dim rangeToDelete As Range 

    ' Loop through rows. 
    For rowTMP = LBound(DirArray) To UBound(DirArray) 
     combinedTMP = vbNullString ' Clear temp variable. 

     ' Loop through each cell in the row and get all values combined. 
     For colTMP = 1 To tbl.DataBodyRange.Columns.Count 
      combinedTMP = combinedTMP & DirArray(rowTMP, colTMP) 
     Next colTMP 

     ' Check if row is blank. 
     If combinedTMP = vbNullString Then 
      ' Row is blank. Add this blank row to the range-to-delete. 
      If rangeToDelete Is Nothing Then 
       Set rangeToDelete = tbl.ListRows(rowTMP).Range 
      Else 
       Set rangeToDelete = Union(rangeToDelete, tbl.ListRows(rowTMP).Range) 
      End If 
     End If 
    Next rowTMP 

    ' DELETE BLANK TABLE ROWS (if any) 
    If Not rangeToDelete Is Nothing Then rangeToDelete.Delete 
End Sub 

Cela a des avantages par rapport aux autres méthodes:

1. VITESSE: Dans un essai d'une table avec 200.000 lignes et 8 colonnes, cette méthode a 19 secondes C'est un peu plus de la moitié des 34 secondes que nécessite la méthode SpecialCells(xlCellTypeBlanks) pour une table identique.
2. IDENTIFIE DES RANGÉES DE TABLE BLANCHES COMPLÈTES: Contrairement à d'autres méthodes (telles que this one qui sont réellement très utiles dans certaines situations), cette méthode recherche des blancs dans chaque cellule d'une ligne au lieu d'une seule.

Answer 2

Cela devrait fonctionner. Je ne sais pas si elle est plus rapide, mais il est une autre façon de le faire:

Sub delete_blank_table_rows() 
Dim Rng As Range, tempRng As Range 
Set Rng = Range("Table1") ' Change as necessary 
Set Rng = Range(Cells(Rng.Rows(1).Row, Rng.Columns(1).Column), Cells(Rng.Rows(Rng.Rows.Count).Row, Rng.Columns(Rng.Columns.Count).Column)) 

Dim i  As Long 
For i = Rng.Rows.Count To 1 Step -1 
    Cells(Rng.Rows(i).Row, Rng.Columns(1).Column).Select 
    Set tempRng = Range(Cells(Rng.Rows(i).Row, Rng.Columns(1).Column), Cells(Rng.Rows(i).Row, Rng.Columns(Rng.Columns.Count).Column)) 

    If WorksheetFunction.CountA(tempRng) = 0 Then 
     tempRng.Delete shift:=xlUp 
    End If 

Next i 
End Sub 

Edit: Et bien sûr, pour l'accélérer, vous devez désactiver Mise à jour de l'écran, calcul alors qu'il fonctionne.

Answer 3

Je pense que cela peut être plus rapide (vous pouvez modifier LastRow et lastcol pour répondre à vos dimensions de la table):

Sub delete_rows_blank2() 

t = 1 
lastrow = ActiveSheet.UsedRange.Rows.Count 
lastcol = ActiveSheet.UsedRange.Columns.Count 

Do Until t = lastrow 

For j = 1 To lastcol 

    If Cells(t, j) = "" Then 

     j = j + 1 

      If j = lastcol Then 
      Rows(t).Delete 
      t = t + 1 
      End If 

    Else 

     t = t + 1 

    End If 

Next 

Loop 

End Sub