Optimiser code: suppression colonnes vides

Bonjour,

Est-ce que tu peux décrire ce que tu tentes de faire?

Cela pourrait aider ceux qui voudraient t'aider!


MichD
---------------------------------------------------------------

Je précise ce que j'ai voulu faire:
- je compte le nombre de cellules non vide en incluant la deuxième ligne d'en-tête(j'ai 2 lignes d'en-tête)
- si mon résultat vaut 1, je supprime la colonne (j'ai pris une ligne d'e n-tête parce que sinon, avec 0 ça me posait problème).

Merci

Ici, nbcolTOT=776

Et je me mets en ligne 30000 pour être sûre d'être en dessous de me s lignes.



For i = 12 To nbcolTOT

Cells(30000, i).FormulaR1C1 = "=COUNTA(R[-29998]C:R[-1]C)"

Next i



c = 12

Do While Cells(2, c) <> ""

If (Cells(30000, c)) = "1" Then

Range(Cells(1, c), Cells(30000, c)).Delete Shift:=xlToLeft

c = c - 1

End If

c = c + 1

Loop

Bonjour,

Essaie ceci. Prends le temps d'adapter le nom de la
feuille dans la procédure.


'------------------------------------------
Sub test1()
Dim DerLig As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
With Worksheets("Feuil1") 'Nom feuille à adapter
DerLig = .Range("B:G").Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set Rg = .Range("B2:B" & DerLig).Resize(, 12)
End With

With Rg
For A = .Columns.Count To 1 Step -1
If Evaluate("CountA(" & .Columns(A).Address & ")") = 1 Then
.Columns(A).EntireColumn.Delete (xlToLeft)
End If
Next
End With
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
'------------------------------------------


MichD
---------------------------------------------------------------

Super, merci, ça marche et c'est super rapide :)

Le vendredi 22 février 2013 15:11:56 UTC+1, sthib...@gmail.com a écrit  :

Super, merci, ça marche et c'est super rapide :)

J'ai encore presque le même problème, mais cette fois pour supprimer de s lignes vides. J'ai essayé d'appliquer le nouveau code, mais ça ne mar che pas parce que là je ne veux pas supprimer la ligne mais juste 3 cellu les.
Mon code initial était ça:
Tant que ma cellule n'est pas vide

Si ma cellule est vide, je supprime la cellule et les deux précédentes.
Et je boucle sur différentes colonnes (c) et je balaie plusieurs lignes.
Mais c'est trop lent.

Merci

c = 3
Do While Cells(1, c) <> ""
ligne = 8
Do While Cells(ligne, c - 1) <> ""
If Cells(ligne, c) = "" Then
Range(Cells(ligne, c - 2), Cells(ligne, c)).Delete Shift:=xlU p
ligne = ligne - 1
End If
ligne = ligne + 1
Loop
c = c + 4
Loop

Tu dois décrire comme tes données sont situées sur la feuille.

- Nom de la feuille
- Adresse de la plage de cellules concernées
- Dans cette plage, quelles sont les colonnes de la
plage cellules concernées qui doivent être vides?

Et si c'est 3 cellules de chacune des lignes sont vides,
on supprimer les cellules, et tu remontes les données
vers le haut?


MichD
---------------------------------------------------------------

- Nom de la feuille : Plante

- Adresse de la plage de cellules concernées A1:C776

- Dans cette plage, quelles sont les colonnes de la plage cellules concern ées qui doivent être vides? la colonne C

Et si ces 3 cellules de chacune des lignes sont vides,
on supprimer les cellules, et tu remontes les données
vers le haut? Non, juste si la celulle de la colonne C est vide, on supprim e les cellules de la ligne concernées en remontant les données vers le haut.

Par exemple: si C8 est vide, alors supprimes A8:C8 en remontant vers le hau t

Est-ce plus clair ?

Supprimer la totalité de la ligne si la colonne C est vide :

'----------------------------
Sub Test()

Application.EnableEvents = False
With Worksheets("Plante")
With .Range("C1:C776")
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End With
Application.EnableEvents = True
End Sub
'----------------------------

MichD
---------------------------------------------------------------

Une autre version qui efface seulement les lignes des
colonnes A, B, C sans toucher au reste de la feuille.

'--------------------------------------
Sub Test1()
Dim A As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("Plante")
With .Range("C1:C" & .Range("C65536").End(xlUp).Row)
With .SpecialCells(xlCellTypeBlanks)
For A = 1 To 3
.Offset(, -3 + A).Delete xlUp
Next
End With
End With
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'--------------------------------------

MichD
---------------------------------------------------------------