XL 2016 regrouper cellules

camoo

XLDnaute Nouveau
Bonjour à tous,
Afin d'alléger un tableau très fourni, je voudrais regrouper un carré de cellules pour ensuite pouvoir les masquer.
Le problème est que je ne veux donc pas regrouper des lignes entières !
Pouvez-vous m'aider ?!
Merci d'avance !!

Edit : je tente d'utiliser la fonction grouper mais seulement pour une zone limitée de cellules, et pas pour des lignes / colonnes entières.
 
Dernière édition:

camoo

XLDnaute Nouveau
Ahh j'ai réussi! merci , mais malheureusement ce n'est pas le résultat que je voulais ahah.
Est-il possible de résumer ces cellules dans une cellule de titre disons et donc qu'elles disparaissent / apparaissent seulement quand j'en ai besoin ?
Ce qui me permettrait de réduire la taille de mon tableau sans laisser des cellules vides ?
 

camoo

XLDnaute Nouveau
Bonjour à tous,

Vous pensez sérieusement que ceci est compréhensible :
Avec un fichier joint peut-être ?

A+
Bonjour Job75,
Puisque je l'ai écrit comme ceci je le pense compréhensible oui. Je n'y connais pas grand chose sur excel, il est donc difficile pour moi d'exprimer ma demande, mais je vous remercie pour la sympathie de votre message.
Et malheureusement non je ne peux pas vous montrer mon document.
 

job75

XLDnaute Barbatruc
Bah on peut toujous bricoler avec la boule de cristal :
VB:
Sub Regrouper()
Dim tablo, ncol%, i&, j%, x$
With [B3].CurrentRegion 'à adapter
    tablo = .Value 'matrice, plus rapide
    If Not IsArray(tablo) Then Exit Sub
    ncol = UBound(tablo, 2)
    For i = 1 To UBound(tablo)
        For j = 2 To ncol
            tablo(i, 1) = tablo(i, 1) & "-" & tablo(i, j)
            tablo(i, j) = ""
        Next
        If i > 1 Then tablo(1, 1) = tablo(1, 1) & vbLf & tablo(i, 1): tablo(i, 1) = ""
    Next
    Application.ScreenUpdating = False
    .Columns(1).ColumnWidth = 255
    .Value = tablo
    .Rows.AutoFit
    .Columns.AutoFit
End With
End Sub
 

Pièces jointes

  • Regrouper(1).xlsm
    21 KB · Affichages: 3

job75

XLDnaute Barbatruc
Regrouper_Dissocier :
VB:
Sub Regrouper_Dissocier()
Dim tablo, ncol%, i&, j%, s
With [B3].CurrentRegion 'à adapter
    tablo = .Value 'matrice, plus rapide
    If IsArray(tablo) Then
        ActiveSheet.DrawingObjects(1).Text = "Dissocier"
        ncol = UBound(tablo, 2)
        For i = 1 To UBound(tablo)
            For j = 2 To ncol
                tablo(i, 1) = tablo(i, 1) & "-" & tablo(i, j)
                tablo(i, j) = ""
            Next
            If i > 1 Then tablo(1, 1) = tablo(1, 1) & vbLf & tablo(i, 1): tablo(i, 1) = ""
        Next
        Application.ScreenUpdating = False
        .Columns(1).ColumnWidth = 255
        .Value = tablo
        .Rows.AutoFit
        .Columns.AutoFit
    Else
        ActiveSheet.DrawingObjects(1).Text = "Regrouper"
        s = Split(tablo, vbLf)
        If UBound(s) = -1 Then Exit Sub
        ReDim tablo(UBound(s), 0) 'base 0
        For i = 0 To UBound(s)
            tablo(i, 0) = s(i)
        Next
        .Resize(i) = tablo
        .Resize(i).TextToColumns .Cells(1), xlDelimited, Other:=True, OtherChar:="-" 'commande Convertir
        .CurrentRegion.Columns.AutoFit
    End If
End With
End Sub
 

Pièces jointes

  • Regrouper_Dissocier(1).xlsm
    22.1 KB · Affichages: 2

camoo

XLDnaute Nouveau
Bah on peut toujous bricoler avec la boule de cristal :
VB:
Sub Regrouper()
Dim tablo, ncol%, i&, j%, x$
With [B3].CurrentRegion 'à adapter
    tablo = .Value 'matrice, plus rapide
    If Not IsArray(tablo) Then Exit Sub
    ncol = UBound(tablo, 2)
    For i = 1 To UBound(tablo)
        For j = 2 To ncol
            tablo(i, 1) = tablo(i, 1) & "-" & tablo(i, j)
            tablo(i, j) = ""
        Next
        If i > 1 Then tablo(1, 1) = tablo(1, 1) & vbLf & tablo(i, 1): tablo(i, 1) = ""
    Next
    Application.ScreenUpdating = False
    .Columns(1).ColumnWidth = 255
    .Value = tablo
    .Rows.AutoFit
    .Columns.AutoFit
End With
End Sub


J'ai tenté, les informations dans les cellules de toutes le lignes sélectionnées se sont effacées.
 

dg62

XLDnaute Barbatruc
Bonjour à Tous,

Masquer une ligne ou un groupe de lignes c'est faisable
Masquer une colonne ou un groupe de colonne idem
mais masquer une cellule ou un groupe c'est impossible. La cellule est l'intersection d'une ligne et d'une colonne.
de la même façon il est impossible de modifier la largeur ou la hauteur d'une cellule sans modifier la ligne ou la colonne entière.
bien sur dans la mesure ou j'ai correctement compris votre demande.
 

camoo

XLDnaute Nouveau
Bonjour à Tous,

Masquer une ligne ou un groupe de lignes c'est faisable
Masquer une colonne ou un groupe de colonne idem
mais masquer une cellule ou un groupe c'est impossible. La cellule est l'intersection d'une ligne et d'une colonne.
de la même façon il est impossible de modifier la largeur ou la hauteur d'une cellule sans modifier la ligne ou la colonne entière.
bien sur dans la mesure ou j'ai correctement compris votre demande.

Bonjour dg62,
Effectivement c'était bien ma question !
Merci beaucoup pour la réponse:)
 

job75

XLDnaute Barbatruc
Ma boule de cristal a vu autre chose :
Ce qui me permettrait de réduire la taille de mon tableau sans laisser des cellules vides ?
ce qui nous donne ipso facto cette macro :
VB:
Sub Affiche_Masque()
Dim o As Object, i&
Set o = ActiveSheet.DrawingObjects(1)
o.Text = IIf(o.Text = "Masque", "Affiche", "Masque")
With [A4:H23] 'à adapter
    .Rows.Hidden = False
    .Columns.Hidden = False
    If o.Text = "Affiche" Then
        For i = 1 To .Rows.Count
            If Application.CountA(.Rows(i)) = 0 Then .Rows(i).Hidden = True
        Next
        For i = 1 To .Columns.Count
            If Application.CountA(.Columns(i)) = 0 Then .Columns(i).Hidden = True
        Next
    End If
End With
End Sub
 

Pièces jointes

  • Affiche_Masque(1).xlsm
    22.9 KB · Affichages: 5

camoo

XLDnaute Nouveau
Ma boule de cristal a vu autre chose :

ce qui nous donne ipso facto cette macro :
VB:
Sub Affiche_Masque()
Dim o As Object, i&
Set o = ActiveSheet.DrawingObjects(1)
o.Text = IIf(o.Text = "Masque", "Affiche", "Masque")
With [A4:H23] 'à adapter
    .Rows.Hidden = False
    .Columns.Hidden = False
    If o.Text = "Affiche" Then
        For i = 1 To .Rows.Count
            If Application.CountA(.Rows(i)) = 0 Then .Rows(i).Hidden = True
        Next
        For i = 1 To .Columns.Count
            If Application.CountA(.Columns(i)) = 0 Then .Columns(i).Hidden = True
        Next
    End If
End With
End Sub

Excel me dit qu'il y a une erreur d'exécution '1004' :
"impossible de lire la propriété DrawingObjects de la classe worksheet" .
J'imagine qu'il faut que je télécharge quelque chose ?
 

Discussions similaires

Réponses
2
Affichages
158

Statistiques des forums

Discussions
312 201
Messages
2 086 172
Membres
103 152
dernier inscrit
Karibu