XL 2010 Supprimer des cellules vides avec une condition

[bagheera]

Bonjour à tous les excelleurs !!!

Mon challenge du jour : je cherche un moyen de supprimer, dans tout un tableau, toutes mes cellules vides mais la condition est que les cellules restantes doivent rester avec leur valeur de référence présente en colonne A.

Fichier en exemple : tableau de base en A:C et après suppression des cellules manière traditionnelle en E:G et le résultat attendu en I:K.

Le code couleur est juste pour me confirmer que les valeurs restantes restent avec leur valeur de référence de la colonne A.

Des idées ?

 

[sylvanu]

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 ?

 

[mapomme]

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" :

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

 

[bagheera]

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 ?

Merci beaucoup ! Effectivement, ma matrice est bien plus grande et ça prend un peu de temps de traitement mais ça reste très correct par rapport à un traitement manuel XD

Je dois utiliser le tableur d'un autre service pour l'injecter dans mon logiciel de traitement et toutes ces cases blanches créaient des bugs d'ingestion...

 

[bagheera]

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" :

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

C'est magique et parfait ! En un clic et un traitement au delà de mes espérances !!! Merci beaucoup !!!