Supprimer lignes et colonnes par variable tableau
Bonjour,
J'ai une feuille avec 145 colonnes et je supprime les
colonnes vides (qui ne comportent que l'entête), ainsi que les lignes
vides, pour ne conserver que celles qui contiennent des données.
Actuellement je le fais avec la procédure suivante et j'aimerais améliorer le code et l'accélérer en utilisant une variable tableau.
Je suis preneur de tous les conseils et idées.
Merci d'avance pour l'aide apportée.
Dan
Sub Suppression_Lignes_et_Colonnes_Vides()
'Boucle sur l'ensemble des lignes et colonnes du fichier de données et supprime les éventuelles lignes et colonnes vides
Dim DerCol As Integer
Dim DerLig As Long
Dim i As Integer
Set WsD = Worksheets("Donnees")
WsD.Activate
DerCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
DerLig = Cells(Cells.Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
'Suppression des lignes vides
For i = DerLig To 1 Step -1
If WorksheetFunction.CountIf(Range(Cells(i, 1), Cells(i, DerCol)), "<>") = 0 Then
Rows(i).Delete
End If
Next i
'Suppression des colonnes vides
For i = DerCol To 1 Step -1
If WorksheetFunction.CountIf(Range(Cells(2, i), Cells(DerLig, i)), "<>") = 0 Then
Columns(i).Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Bonjour Dan,
En effet passer par des tableaux rendra le code beaucoup plus rapide à exécuter, pour ce faire il faudra:
tableau = range("a1",cells(DerLig,DerCol))
pour avoir un tableau contenant toutes tes données, ensuite pour parcourir ton tableau:
For i = lbound(tableau,1) to ubound(tableau,1)
pour parcourir toutes les lignes du tableau, on pourrait aussi utiliser 1 et DerLig dans ce ca, mais j'ai pris l'habitude de lbound et ubound qui fonctionnent toujours, sans se poser la question d'où commence et se termine le tableau.
Pour les colonnes ça va beaucoup y ressembler:
For j = lbound(tableau,2) to ubound(tableau,2)
on prend juste la deuxièmes dimension du tableau au lieu de la première, encore pour cette fois on pourrait utiliser 1 et DerCol.
Ah si petit changement, au lieu de faire un countif, on va utiliser une petite astuce, on va parcourir toutes les lignes, et toutes les colonnes de ces lignes, à la façon d'un countif pour regarder qu'est-ce qui est vide, et qu'est ce qui ne l'est pas.
ça devrait donner:
Sub Suppression_Lignes_et_Colonnes_Vides()
'Boucle sur l'ensemble des lignes et colonnes du fichier de données et supprime les éventuelles lignes et colonnes vides
Dim DerCol As Integer
Dim DerLig As Long
Dim i As Integer, j as Integer
Dim lignes() as Long, colonnes() as Long
Set WsD = Worksheets("Donnees")
WsD.Activate
DerCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
DerLig = Cells(Cells.Rows.Count, 1).End(xlUp).Row
reDim lignes(1 to DerLig)
reDim colonnes(1 to DerCol)
Application.ScreenUpdating = False
'comptage des cases non vides
For i = LBound(tableau, 1) To UBound(tableau, 1)
For j = LBound(tableau, 2) To UBound(tableau, 2)
If tableau(i, j) <> "" Then
lignes(i) = lignes(i) + 1
colonnes(j) = colonnes(j) + 1
End If
Next j
Next i
'Suppression des lignes vides
For i = UBound(lignes, 1) To LBound(lignes, 1) Step -1
If lignes(i) = 0 Then
Cells(i, 1).EntireRow.Delete
End If
Next i
'Suppression des colonnes vides
For j = UBound(colonnes, 1) To LBound(colonnes, 1) Step -1
If colonnes(j) = 0 Then
Cells(1, j).EntireColumn.Delete
End If
Next j
Application.ScreenUpdating = True
End Sub
à tester car je ne suis pas sûr de tout avoir bien codé, mais l'idée est là.
Bonjour à tous,
Au cas où ces colonnes vides seraient dues à des couper/coller, peut-être que supprimer la colonne dans la foulée prendrait moins de temps...
Voici en tout cas un essai alternatif, sans suppression de lignes ni de colonnes, mais en stockant les valeurs dans des tableaux :
Sub Suppression_Lignes_et_Colonnes_Vides()
Dim dl&, dc&, i&, k&, n&, tlignes(), tfinal()
With Worksheets("Donnees")
dc = .Cells(1, .Columns.Count).End(xlToLeft).Column
dl = .Cells(.Rows.Count, 1).End(xlUp).Row
'tableau (transposé) sans ligne vide, à partir de la plage
For i = 1 To dl
If NBVALEURS(.Rows(i)) > 0 Then
n = n + 1: ReDim Preserve tlignes(1 To dc, 1 To n)
For k = 1 To dc
tlignes(k, n) = .Cells(i, k).Value
Next k
End If
Next i
n = 0
'tableau (retransposé) sans colonnes vides, à partir du tableau sans ligne vide
For k = 1 To dc
If NBVALEURS(.Columns(k)) > 0 Then
n = n + 1: ReDim Preserve tfinal(1 To UBound(tlignes, 2), 1 To n)
For i = 1 To UBound(tlignes, 2)
tfinal(i, n) = tlignes(k, i)
Next i
End If
Next k
.UsedRange.ClearContents
.Range("A1").Resize(UBound(tfinal), UBound(tfinal, 2)) = tfinal
End With
End Sub
'Fonction permettant de compter le nombre de valeurs d'une plage
Function NBVALEURS(plage As Range) As Long
NBVALEURS = plage.Cells.Count - Application.CountBlank(plage)
End Function
Il est à noter que worksheetfunction.countif(plage, "<>") équivaut à worksheetfunction.counta(plage) (NBVAL) et a le petit défaut de retenir aussi les chaines vides (résultant d'une formule) dans le décompte... D'où l'utilisation ici de la fonction NBVALEURS.
Cdlt,
Merci beaucoup pour vos réponses et explications, c'est vraiment super sympa !
J'avais commencé à tester la 1ère réponse qui fonctionne bien. Je testerai la seconde par la suite.
J'avais dans l'idée de passer par une variable tableau jusqu'au bout de la procédure. C'est à dire de supprimer les lignes et colonnes vides dans le tableau et pas directement sur la feuille -> (en fait il y a souvent assez peu de colonnes renseignées et ça prend pas mal de temps à les supprimer sur la feuille), puis de coller ce tableau sur la feuille, ce qui ferait gagner encore bien plus en rapidité.
J'ai très légèrement modifié le code notamment pour la suppression des colonnes, car l'entête de colonne est toujours renseigné, même si la colonne ne contient aucune donnée.
Sub Suppression_Lignes_et_Colonnes_Vides()
'Boucle sur l'ensemble des lignes et colonnes du fichier de données et supprime les éventuelles lignes et colonnes vides
Dim Tablo As Variant
Dim DerCol As Integer
Dim DerLig As Long
Dim i As Integer, j As Integer
Dim lignes() As Long, colonnes() As Long
Set WsD = Worksheets("Donnees")
WsD.Activate
DerCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
DerLig = Cells(Cells.Rows.Count, 1).End(xlUp).Row
ReDim lignes(1 To DerLig)
ReDim colonnes(1 To DerCol)
Application.ScreenUpdating = False
Tablo = WsD.UsedRange
'comptage des cases non vides
For i = LBound(Tablo, 1) To UBound(Tablo, 1)
For j = LBound(Tablo, 2) To UBound(Tablo, 2)
If Tablo(i, j) <> "" Then
lignes(i) = lignes(i) + 1
colonnes(j) = colonnes(j) + 1
End If
Next j
Next i
'************
'Suppression des lignes et colonnes directement dans la var 'Tablo'
'************
'Suppression des lignes vides
For i = UBound(lignes, 1) To LBound(lignes, 1) Step -1
If lignes(i) = 0 Then
Cells(i, 1).EntireRow.Delete
End If
Next i
'Suppression des colonnes vides
For j = UBound(colonnes, 1) To LBound(colonnes, 1) Step -1
If colonnes(j) <= 1 Then
Cells(1, j).EntireColumn.Delete
End If
Next j
Application.ScreenUpdating = True
End Sub
Ah oui bien sûr, on peut alors choisir de transférer uniquement les lignes et colonnes ayant plus de 0, ça donnerait:
Sub Suppression_Lignes_et_Colonnes_Vides()
'Boucle sur l'ensemble des lignes et colonnes du fichier de données et supprime les éventuelles lignes et colonnes vides
Dim DerCol As Integer
Dim DerLig As Long
Dim i As Integer, j As Integer
Dim lignes() As Long, colonnes() As Long
Dim nbLig As Long, nbCol As Long
Dim tableau, tabFin
Dim lig As Long, col As Long
Set WsD = Worksheets("Donnees")
WsD.Activate
DerCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
DerLig = Cells(Cells.Rows.Count, 1).End(xlUp).Row
ReDim lignes(1 To DerLig)
ReDim colonnes(1 To DerCol)
Application.ScreenUpdating = False
'comptage des cases non vides
For i = LBound(tableau, 1) To UBound(tableau, 1)
For j = LBound(tableau, 2) To UBound(tableau, 2)
If tableau(i, j) <> "" Then
lignes(i) = lignes(i) + 1
colonnes(j) = colonnes(j) + 1
End If
Next j
Next i
'définition des dimensions du tableau final
For i = LBound(lignes, 1) To UBound(lignes, 1)
If lignes(i) > 0 Then nbLig = nbLig + 1
Next i
For j = LBound(colonnes, 1) To UBound(colonnes, 1)
If colonnes(j) > 0 Then nbCol = nbCol + 1
Next j
ReDim tabFin(1 To nbLig, 1 To nbCol)
'transfert des lignes et colonnes non vides dans le tableau final
lig = 1
For i = LBound(lignes, 1) To UBound(lignes, 1)
If lignes(i) > 0 Then
col = 1
For j = LBound(colonnes, 1) To UBound(colonnes, 1)
If colonnes(j) > 0 Then
tabFin(lig, col) = tableau(i, j)
lig = lig + 1
col = col + 1
End If
Next j
End If
Next i
'export du résultat
Range("a1").Resize(UBound(tabFin, 1), UBound(tabFin, 2)) = tabFin
Application.ScreenUpdating = True
End Sub
à tester car j'ai potentiellement fait des erreurs comme je n'ai pas pu tester le code...
Merci pour ce complément.
Pour l'instant ça ne fonctionne pas normalement.
Je joins un fichier ex. pour une meilleure compréhension. Si ça vous prend trop de temps, ne donnez pas suite. Pour ma part, je cherche surtout à comprendre la méthode afin de l'utiliser dans mes prochains développements.
J'ai aussi mis un bouton sur la feuille 'Donnees' qui recopie les données depuis la feuille 'Donnees_Copie' pour gagner du temps.
Merci encore pour l'aide et le temps passé.
Bonsoir,
J'ai pu corriger le code avec le fichier, comme quoi ça rend tout plus simple
Je joins le résultat, si vous avez besoin d'explications sur le code n'hésitez pas, le mode pas à pas en mode débogage aide déjà bien à comprendre ce qu'il se passe à chaque endroit.
Fantastique !
Ça va à la vitesse de la lumière ! Je n'ai pas encore tout compris, mais il faut que je m'y intéresse et que je comprenne tout pour la suite des mes développements.
Merci beaucoup pour l'aide apportée.
Dan