Supprimer des cellules vides inutiles

Toubabou · 12 Mars 2015

Bonjour à tous,

J'ai un tableau où se trouve des cellules non remplies, donc inutiles pour moi. je voudrais supprimer ces cellules et que celles remplies se regroupent.
Pourriez vous m'aider.

Merci par avance,

Toubabou

job75 · 14 Mars 2015

Re : Supprimer des cellules vides inutiles

Bonjour à tous,

Ce que je ne comprends pas c'est que Toubabou veuille supprimer les lignes.

La feuille s'appelant "IMPRESSION" c'est pour l'imprimer non ?

Alors il suffit de masquer les lignes, voyez le fichier joint et cette macro affectée aux boutons :

Code:

Sub AfficherMasquer()
Dim textdeb$, Ntitres&, masque As Boolean, o As Object, i&, P As Range
textdeb = "SDIS" 'début de chaque tableau
Ntitres = 11 'nombre de lignes de titres
masque = ActiveSheet.DrawingObjects(Application.Caller).Text = "Masquer"
'---texte des boutons Afficher/Masquer---
For Each o In ActiveSheet.DrawingObjects
  If masque And o.Text = "Masquer" Then o.Text = "Afficher"
  If Not masque And o.Text = "Afficher" Then o.Text = "Masquer"
Next
'---affiche/masque les lignes non cochées---
Rows.Hidden = False 'affiche tout
If masque Then
  For i = 1 To Application.Match("zzz", [A:A])
    If Trim(Cells(i, 1)) = textdeb Then i = i + Ntitres
    If Application.CountIf(Rows(i), "ü") = 0 Then _
      Set P = Union(IIf(P Is Nothing, Rows(i), P), Rows(i))
  Next
  If Not P Is Nothing Then P.EntireRow.Hidden = True
End If
End Sub

Il peut y avoir autant de tableaux que vous voulez pourvu qu'ils commencent par "SDIS".

Nota : dans les propriétés des boutons mieux vaut décocher "Imprimer l'objet"...

Bonne journée et A+

job75 · 14 Mars 2015

Re : Supprimer des cellules vides inutiles

Re,

Si l'on tient à supprimer les lignes c'est plus simple :

Code:

Sub SupprimerLignes()
Dim textdeb$, Ntitres&, i&, sup As Range
textdeb = "SDIS" 'début de chaque tableau
Ntitres = 11 'nombre de lignes de titres
For i = 1 To Application.Match("zzz", [A:A])
  If Trim(Cells(i, 1)) = textdeb Then i = i + Ntitres
  If Application.CountIf(Rows(i), "ü") = 0 Then _
    Set sup = Union(IIf(sup Is Nothing, Rows(i), sup), Rows(i))
Next
If Not sup Is Nothing Then sup.Delete
End Sub

Fichier (2).

A+

job75 · 14 Mars 2015

Re : Supprimer des cellules vides inutiles

Re,

S'il y a beaucoup de zones disjointes à masquer ou à supprimer (en gros plus de 500), il vaut mieux traiter les tableaux un par un :

Code:

Sub AfficherMasquer()
Dim textdeb$, Ntitres&, masque As Boolean, o As Object, i&, P As Range
textdeb = "SDIS" 'début de chaque tableau
Ntitres = 11 'nombre de lignes de titres
masque = ActiveSheet.DrawingObjects(Application.Caller).Text = "Masquer"
'---texte des boutons Afficher/Masquer---
For Each o In ActiveSheet.DrawingObjects
  If masque And o.Text = "Masquer" Then o.Text = "Afficher"
  If Not masque And o.Text = "Afficher" Then o.Text = "Masquer"
Next
'---affiche/masque les lignes non cochées---
Rows.Hidden = False 'affiche tout
If masque Then
  Application.ScreenUpdating = False
  For i = 1 To Application.Match("zzz", [A:A])
    If Trim(Cells(i, 1)) = textdeb Then
      If Not P Is Nothing Then P.EntireRow.Hidden = True
      Set P = Nothing
      i = i + Ntitres
    End If
    If Application.CountIf(Rows(i), "ü") = 0 Then _
      Set P = Union(IIf(P Is Nothing, Rows(i), P), Rows(i))
  Next
  If Not P Is Nothing Then P.EntireRow.Hidden = True 'dernier tableau
  Application.ScreenUpdating = True
End If
End Sub

Code:

Sub SupprimerLignes()
Dim textdeb$, Ntitres&, i&, sup As Range
textdeb = "SDIS" 'début de chaque tableau
Ntitres = 11 'nombre de lignes de titres
Application.ScreenUpdating = False
For i = 1 To Application.Match("zzz", [A:A])
  If Trim(Cells(i, 1)) = textdeb Then
    i = i + Ntitres
    If Not sup Is Nothing Then
      i = i - sup.Count
      sup.EntireRow.Delete
      Set sup = Nothing
    End If
  End If
  If Application.CountIf(Rows(i), "ü") = 0 Then _
    Set sup = Union(IIf(sup Is Nothing, Cells(i, 1), sup), Cells(i, 1))
Next
If Not sup Is Nothing Then sup.EntireRow.Delete 'dernier tableau
Application.ScreenUpdating = True
End Sub

Fichiers (1 bis) et (2 bis).

A+

Toubabou · 14 Mars 2015

Re : Supprimer des cellules vides inutiles

Bonjur Job75,

Je viens d'essayer d'adapter tes codes à mon fichier. Je suis vraiment trop bête et ni arrive pas. je reste convaincu que tes solutions fonctionnent mais je ne suis pas encore assez calé en VBA. Je garde tes informations pour plus tard lorsque j'aurais évolué.

Je te remercie beaucoup pour ton travail. Désolé. Merci beaucoup

Toubabou

job75 · 14 Mars 2015

Re : Supprimer des cellules vides inutiles

Re,

Si vous n'arrivez pas à adapter montrez-nous simplement le fichier avec ce que vous avez fait.

A+

Toubabou · 14 Mars 2015

Re : Supprimer des cellules vides inutiles

Bonsoir Job75,

Identifiant : Administrateur
MP : 0000

Ce que je recherche :
- Que l’onglet « IMPRESSION » ressemble à l’onglet « BUT »(je viens de le faire manuellement et cela m’a pris 1 h 30 mn)
- Que , en cas de modification par le biais de l’UserForm, les informations soient rajoutées en respectant la mise en forme de l’onglet « BUT ».
Ceci dans le but d’économiser du papier lors des impressions et donc de contribuer à preserver la nature.

Dans tout les cas l’onglet « IMPRESSION » et l’onglet « Param » sont cachés et protégés par « PROTEGER LE CLASSEUR »

Amicalement,

Toubabou

Mon fichier: (c) CJoint.com, 2012

Victor21 · 14 Mars 2015

Re : Supprimer des cellules vides inutiles

Bonjour à tous, bonjour Gérard.

[Joke]
Je ne comprends pas : sur Excel 2003, j'ai essayé de supprimer toutes les lignes, mais il y en a toujours autant (65 536).
Je peux les déplacer, les masquer, en effacer le contenu, mais impossible d'en supprimer. Je viens de m'apercevoir que c'est le même problème pour les colonnes (256) et même pour les cellules (15 466 496 si je ne me suis pas trompé en les comptant).
Dois-je réinstaller Excel, ou reformater mon disque dur ?
[/Joke]
😉😛😉

job75 · 14 Mars 2015

Re : Supprimer des cellules vides inutiles

Re, hello Patrick 🙂

Je pensais que le problème était de supprimer des lignes de la feuille.

Mais au vu du fichier du post #21 ce n'est pas du tout ça.

Vous voulez en fait regrouper des paquets de 3 cellules dans chaque tableau.

Je n'ai jamais vu un truc pareil demandé sur ce forum, alors je vous abandonne à vos fantasmes.

A+

klin89 · 14 Mars 2015

Re : Supprimer des cellules vides inutiles

Bonsoir à tous,🙂

job75,
mapomme a, en partie, trouvé la solution dans le fichier du post #11,
reste à l'adapter sur plusieurs zones.

Klin89

Toubabou · 15 Mars 2015

Re : Supprimer des cellules vides inutiles

job75 à dit:
Je n'ai jamais vu un truc pareil demandé sur ce forum, alors je vous abandonne à vos fantasmes.

A+

Merci.
Toubabou

job75 · 15 Mars 2015

Re : Supprimer des cellules vides inutiles

Bonjour Toubabou, le forum,

J'étais en pétard hier soir parce que j'avais perdu mon temps.

Pour me faire pardonner voyez cette macro dans le code de la feuille BUT :

Code:

Private Sub Worksheet_Activate()
'la feuille "IMPRESSION" doit obligatoirement comporter 15 colonnes
'réparties en 3 groupes de 5
Dim ligdeb%, textdeb$, Ntitres%, hmax%, c As Range, T As Range
Dim h%, tablo, rest(), n%, col%, lig%, i%, j%, k%
'---données initiales à adapter---
ligdeb = 83 '1ère ligne du 1er tableau
textdeb = "SDIS 57"
Ntitres = 11 'nombre de lignes des titres
hmax = 36 'hauteur initiale des tableaux
Application.ScreenUpdating = False
'---RAZ de la feuille---
Cells.Clear 'efface tout
Sheets("IMPRESSION").Cells.Copy
[A1].PasteSpecial xlPasteValues 'collage spécial-valeurs
[A1].PasteSpecial xlPasteFormats 'collage spécial-formats
[A:O].FormatConditions.Delete 'supprime les MFC
[P1].Copy [P1] 'vide le presse-papiers
Application.Goto [A1:O1], True 'cadrage
ActiveWindow.Zoom = True 'zoom
'---traitement de chaque tableau---
For Each c In [A:A].SpecialCells(xlCellTypeConstants)
  If c.Row >= ligdeb And Trim(c) = textdeb Then
    Set T = c(Ntitres + 1).Resize(hmax, 15)
    h = Application.RoundUp(Application.CountIf(T, "ü") / 3, 0)
    If h Then
      tablo = T 'matrice, plus rapide
      ReDim rest(1 To h, 1 To 15)
      n = 0
      For col = 1 To 11 Step 5
        For lig = 1 To hmax
          If tablo(lig, col + 4) = "ü" Then
            i = (n Mod h) + 1
            j = Int(n / h)
            j = IIf(j = 0, 1, IIf(j = 1, 6, 11))
            For k = 0 To 4
              rest(i, j + k) = tablo(lig, col + k)
            Next k
            n = n + 1
          End If
        Next lig
      Next col
      T(1).Resize(h, 15) = rest
    End If
    If h < hmax Then T(h + 1, 1).Resize(hmax - h).EntireRow.Delete
  End If
Next c
End Sub

Fichier zippé joint.

Nota 1 : il ne faut surtout pas modifier la feuille IMPRESSION puisqu'elle contient des formules de liaisons avec la feuille LUTIN, c'est très bien de la masquer.

Nota 2 : dans votre fichier sur cjoint, au 3ème tableau de la feuille BUT, vous avez inscrit une coche qui n'en est pas une...

A+

job75 · 15 Mars 2015

Re : Supprimer des cellules vides inutiles

Re,

Concernant vos Mises en forme conditionnelles (MFC) :

- dans la feuille IMPRESSION au lieu de la formule =NON(ESTERREUR(CHERCHE("ü";E94)))

il est nettement plus simple d'utiliser La valeur de la cellule est => égale à => ="ü"

- dans la feuille BUT elles sont inutiles, j'ai ajouté cette ligne dans la macro précédente :

Code:

[A:O].FormatConditions.Delete 'supprime les MFC

A+

Toubabou · 15 Mars 2015

Re : Supprimer des cellules vides inutiles

Re Job75,

Vous n'avez pas à vous faire pardonner car je pense surtout que mes explications au départ n'étaient pas dès plus clair et je comprend très bien que de faire un travail pour rien 'est pas agréable.
Votre dernière version semble parfaitement répondre à ma demande, mis à part le faite que pour certaines Colonnes "MATRICULE", le format n'est pas toujours celui que je voulais, a savoir
Non Gras, et surtout format Texte afin qu'il accepte une saisie de type "0000000". Alors est ce que je peux faire la modification directement dans les cellules ou alors faut-il passer par le code?
A+

job75 · 15 Mars 2015

Re : Supprimer des cellules vides inutiles

Re,

Vous pouvez formater la feuille source IMPRESSION comme vous voulez.

Mais il est facile de formater chaque tableau de la feuille BUT.

Dans cette macro j'ai mis le format Texte "@" mais le format Nombre "0000000" serait peut-être mieux :

Code:

Private Sub Worksheet_Activate()
'la feuille "IMPRESSION" doit obligatoirement comporter 15 colonnes
'réparties en 3 groupes de 5
Dim ligdeb%, textdeb$, Ntitres%, hmax%, c As Range, T As Range
Dim h%, tablo, rest(), n%, col%, lig%, i%, j%, k%
'---données initiales à adapter---
ligdeb = 83 '1ère ligne du 1er tableau
textdeb = "SDIS 57"
Ntitres = 11 'nombre de lignes des titres
hmax = 36 'hauteur initiale des tableaux
Application.ScreenUpdating = False
'---RAZ de la feuille---
Cells.Clear 'efface tout
Sheets("IMPRESSION").Cells.Copy
[A1].PasteSpecial xlPasteValues 'collage spécial-valeurs
[A1].PasteSpecial xlPasteFormats 'collage spécial-formats
[A:O].FormatConditions.Delete 'supprime les MFC
[P1].Copy [P1] 'vide le presse-papiers
Application.Goto [A1:O1], True 'cadrage
ActiveWindow.Zoom = True 'zoom
'---traitement de chaque tableau---
For Each c In [A:A].SpecialCells(xlCellTypeConstants)
  If c.Row >= ligdeb And Trim(c) = textdeb Then
    Set T = c(Ntitres + 1).Resize(hmax, 15)
    h = Application.RoundUp(Application.CountIf(T, "ü") / 3, 0)
    If h Then
      tablo = T 'matrice, plus rapide
      ReDim rest(1 To h, 1 To 15)
      n = 0
      For col = 1 To 11 Step 5
        For lig = 1 To hmax
          If tablo(lig, col + 4) = "ü" Then
            i = (n Mod h) + 1
            j = Int(n / h)
            j = IIf(j = 0, 1, IIf(j = 1, 6, 11))
            For k = 0 To 4
              rest(i, j + k) = tablo(lig, col + k)
            Next k
            n = n + 1
          End If
        Next lig
      Next col
      Intersect(T, [D:D,I:I,N:N]).Font.Bold = False 'police non gras
      Intersect(T, [D:D,I:I,N:N]).NumberFormat = "@" '"0000000"
      T(1).Resize(h, 15) = rest
    End If
    If h < hmax Then T(h + 1, 1).Resize(hmax - h).EntireRow.Delete
  End If
Next c
End Sub

Fichier (2).

A+

Toubabou · 15 Mars 2015

Re : Supprimer des cellules vides inutiles

RE,

Oui le format '00000000' est mieux.

Je vous remercie beaucoup

Amicalement,

Toubabou

Supprimer des cellules vides inutiles

Toubabou

XLDnaute Impliqué

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Toubabou

XLDnaute Impliqué

job75

XLDnaute Barbatruc

Toubabou

XLDnaute Impliqué

Victor21

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

klin89

XLDnaute Accro

Toubabou

XLDnaute Impliqué

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Toubabou

XLDnaute Impliqué

job75

XLDnaute Barbatruc

Pièces jointes

Toubabou

XLDnaute Impliqué

Discussions similaires

Supprimer des cellules vides inutiles

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency