Discussion :

[mouncefdi]

Bonjour tout le monde,


je souhaite effacer les colonnes vides d'un tableau (les 2 premières lignes étant toujours renseignées et les 4 premières colonnes renseignées aussi)

J'ai mis en place le code suivant qui ne marche pas bien ( la macro met un temps fou pour effacer les colonnes vides)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub deleteColonneVide() 
 
Dim i As Long, j As Byte, x As Variant 
Dim dernierecolonne As Integer 
Dim colonne As Range 
Dim mysheet As Worksheet 
 
 
 
Set mysheet = Sheets("ABC") 
 
dernierecolonne = Range("IV2").End(xlToLeft).Column 
 
j = 4 
while j<= dernierecolonne 
For i = 4 To Cells.Find("*", , , , , xlPrevious).Row 
If Cells(i, j) <> "" Then x = x + 1 
Next i 
 
If x = 0 Then 
Cells(65536, j).Select 
Range(Selection, Selection.End(xlUp)).Select 
Selection.Delete Shift:=xlToLeft 
j=j-1
End If: x = 0: 
j=j+1 
wend 
Set mysheet = Nothing 
End Sub

merci d'avance pour l'aide

@+

[Jean-Philippe André]

salut,
ici tu souhaites supprimer les colonnes, et non pas les effacer, c'est bien cela ?
est-ce donc logique de supprimer la totalité de la colonne, et pas seulement les 65534 dernières lignes ?

[mouncefdi]

je souhaite supprimer entierement les colonnes vides (vides à partir de la 3ème ligne jusqu'à la dernière ligne renseigné) (dernière ligne renseigné = derniere ligne où la cells(i,4) est <> "")

Pour les courgeux, un petit fichier joint pour expliquer ce que je souhaite faire....
supprimer les colonnes vides (à partir de la ligne3 jusqu'à la dernière ligne renseignée)

c'est très clair une fois le fichier sous les yeux, la macro mise en place est la suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub deleteColonneVide()
 
Dim i As Long, j As Byte, x As Variant
Dim dernierecolonne As Integer
Dim colonne As Range
Dim mysheet As Worksheet
 
 
 
Set mysheet = Sheets("Sheet1")
 
dernierecolonne = Range("IV2").End(xlToLeft).Column
 
For j = 4 To dernierecolonne
For i = 4 To Cells.Find("*", , , , , xlPrevious).Row
If Cells(i, j) <> "" Then x = x + 1
Next i
 
If x = 0 Then
Cells(65536, j).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.Delete Shift:=xlToLeft
End If: x = 0: Next j
Set mysheet = Nothing
End Sub

[Fvandermeulen]

Salut Mounefdi et JPcheck,

Voici une proposition j'ai utilisé Application.Subtotal pour vérifier le contenu de ta colonne car j'imagine que le nombre de ligne varie (ca évite de repasser par une boucle ou un comptage de ligne... tout ça pour dire que c'est une des manières de procéder)
Je te laisse voir si ça te convient...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub DeleteCol()
 
Dim MyCheck As Integer
Dim NbCol As Integer
Dim i As Integer
 
NbCol = Sheets("sheet1").UsedRange.Columns.Count
 
For i = NbCol To 1 Step -1
    MyCheck = Application.Subtotal(3, Sheets("sheet1").Columns(i)) - 1 'Subtotal 3 = count; -1 car titre
    If MyCheck = 0 Then Sheets("sheet1").Columns(i).Delete
Next i
End Sub

A+

[casavba]

Solution rapide à adapter en cas de besoin.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Test()
 
Dim NRow As Integer
NRow = 2 'Numero de ligne des entêtes
 
    For i = Columns.Count To 1 Step -1
 
        Cells(NRow, i).Select
        Range(Selection, Selection.End(xlDown)).Select
 
        If Selection.End(xlDown).Row = Rows.Count Then _
            Columns(Selection.End(xlDown).Column).Delete
 
    Next
 
End Sub

Bonne journée

[mouncefdi]

Merci pour vos interventions..

Je tiens a te remercier tout particulièremenet : Fvandermeulen
Le code est super, merci beaucoup

Pbm résolu, Merci