XL 2010 Supprimer des cellules vides avec une condition

sylvanu à dit:

Bonjour Bagheera,
Un essai en PJ.
Comme je travaille directement en cellules, cela peut être long si la matrice est grande.
J'ai mis le temps passé en fin d'exécution.

juste une question : A quoi ça peut bien servir ?

Cliquez pour agrandir...

mapomme à dit:

Bonjour Bagheera , @sylvanu

Une autre version en VBA. Tout (presque tout ) se passe en mémoire. C'est donc assez rapide (0,03 s pour 5000 lignes en entrée).
Cliquez sur le bouton Hop!

Le code est dans le module de code de la feuille "Feuil1" :

VB:

Sub SupprCelVideLigneVide()
Dim der&, t, ref, i&, n1&, n2&, j&, k&, xrg, debut

   debut = Timer: Application.ScreenUpdating = False
   If Me.FilterMode Then Me.ShowAllData
   der = Cells(Rows.Count, "a").End(xlUp).Row
   Range("a:c").Resize(der).Sort key1:=Range("a1"), order1:=xlAscending, Header:=xlYes
   t = Range("a:c").Resize(der)
   ReDim r(1 To UBound(t), 1 To 3)
   r(1, 1) = t(1, 1): r(1, 2) = t(1, 2): r(1, 3) = t(1, 3)
   ref = t(2, 1): n1 = 1: n2 = 1
   For i = 2 To UBound(t)
      If t(i, 1) = ref Then
         r(i, 1) = ref
         If t(i, 2) <> "" Then n1 = n1 + 1: r(n1, 2) = t(i, 2)
         If t(i, 3) <> "" Then n2 = n2 + 1: r(n2, 3) = t(i, 3)
      Else
         ref = t(i, 1)
         n1 = i - 1: n2 = i - 1
         r(i, 1) = ref
         If t(i, 2) <> "" Then n1 = n1 + 1: r(n1, 2) = t(i, 2)
         If t(i, 3) <> "" Then n2 = n2 + 1: r(n2, 3) = t(i, 3)
      End If
   Next i
   For i = 2 To UBound(r)
      If r(i, 2) = "" And r(i, 3) = "" Then r(i, 1) = CVErr(xlErrNA)
   Next i
   Range("a1").Resize(UBound(r), 3) = r
   Range("a:c").Resize(der).Sort key1:=Range("a1"), order1:=xlAscending, Header:=xlYes
   On Error Resume Next
   Range("a:a").Resize(der).SpecialCells(xlCellTypeConstants, xlErrors).Resize(, 3).Delete shift:=xlShiftUp
   On Error GoTo 0
   MsgBox der & " lignes traitées en " & Format(Timer - debut, "0.00\ sec.")
End Sub

Cliquez pour agrandir...