XL 2019 lister le contenu de cellule fusionné

[nadem0068]

Bonjour à tous,
une fois de plus je me tourne vers vous afin de solliciter votre aide.
Je voudrais lister les activités d'un planning dans un tableau pour pouvoir faire des indicateurs.
le planning est rempli manuellement par l'utilisateur.
il peut fusionner plusieurs cellule si l'activité concerne plusieurs personne.
le soucis c'est que dans ce cas quand je veut ressortir la liste des activités cela ne m'affiche pas l'ensemble des participants mais seulement le premier concerné.
je joint un fichier pour que cela puisse être plus clair.

Merci d'avance à tout ceux qui prendront le temps de ce pencher sur mon problème.

 

[patricktoulon]

Bonsoir
j'ai ouvert ton fichier
et pour être honnête avec toi avec un tableau pareil tu va droit dans le mur
alors oui fusionner des cellule peut être joli ou pourrait te paraitre pratique pour gérer
mais tu te trompe
il y a trop de différences entre les lignes et colonnes
là en l'etat je chercherais même pas à automtiser quoi que ce soit
non vraiment c'est WRONG WAY!!

 

[sylvanu]

Bonjour Nadem, Patrick,

non vraiment c'est WRONG WAY!!

Je plussoie totalement à l'avis de Patrick.
Et si vous pouviez éviter ça, vous vous éviteriez pas mal d'aspro.

Cependant, je me suis demandé, "just for the fun", comment je ferais si j'étais vraiment obligé de traiter ça.
Un essai en PJ. Pas sur du tout que ça marche dans toutes les configs, mais au moins ça marche avec l'exemple donné .... et ça m'a amusé.

 

[nadem0068]

Super merci cela me fait une base j'ai trouvé une option qui me donne un résultat similaire.
je suis d'accord avec vous les cellule fusionnées ce n'est pas le top pour traiter des données. Mais la je n'est pas le choix sur la mise en forme malheureusement.
si je trouve la solution je la posterais pour celui qui ce trouvera dans la même situation que moi.

merci pour votre aide.

 

[sylvanu]

Pourquoi ? Ma PJ offre une solution, non ?

 

[sylvanu]

j'ai trouvé une option qui me donne un résultat similaire.

Vous savez, XLD est un site d'échange, pas un supermarché de solutions.
Donc si vous avez trouvé une solution qui résout votre problème, partagez là. Vous en ferez bénéficier toute la communauté.

 

[nadem0068]

Vous savez, XLD est un site d'échange, pas un supermarché de solutions.
Donc si vous avez trouvé une solution qui résout votre problème, partagez là. Vous en ferez bénéficier toute la communauté.

oui je suis bien d'accord.
votre solution ne répond pas à l'ensemble de mon problème mais à une partie seulement. comme je l'ai dit quand j'aurais finalisé l'ensemble de la solution je la posterais pour en faire profiter les autres.

 

[job75]

Bonsoir à tous,

Voyez le fichier joint et cette macro :

Sub Transpose()
Dim source As Range, dest As Range, n As Byte
Set source = [C2:G5] '4 lignes
Set dest = [K2:N6] '5 lignes
Application.ScreenUpdating = False
dest.Resize(25).Clear 'RAZ
For n = 0 To 4
    source.Rows(1 + 4 * n).Resize(4).Copy
    With dest.Rows(1 + 5 * n).Resize(5)
        .PasteSpecial xlPasteAll, Transpose:=True
        .Cells.HorizontalAlignment = xlCenter 'centrage
        Range(.Cells(1, -1), .Cells).Borders.Weight = xlThin
        Range(.Cells(1, -1), .Cells).BorderAround Weight:=xlMedium
    End With
Next
[A1].Select
End Sub

Les cellules fusionnées ne posent aucun problème.

A+

 

[TooFatBoy]

Bonjour,

Une proposition en pièce jointe.

 

[TooFatBoy]

Une autre proposition en pièce jointe, qui semble mieux correspondre au fichier de #1.

 

[job75]

Bonjour le forum,

Je viens de modifier mon post #8.

En effet j'utilisais source.Offset(4 * n) et dest.Offset(5 * n).

Et cela n'allait pas si le lundi il y a une seule activité fusionnée.

A+

 

[job75]

Maintenant si l'on veut défusionner le tableau transposé c'est très simple, fichier (2) :

Sub Transpose()
Dim source As Range, dest As Range, n As Byte, c As Range
Set source = [C2:G5] '4 lignes
Set dest = [K2:N6] '5 lignes
Application.ScreenUpdating = False
dest.Resize(25).Clear 'RAZ
For n = 0 To 4
    source.Rows(1 + 4 * n).Resize(4).Copy
    With dest.Rows(1 + 5 * n).Resize(5)
        .PasteSpecial xlPasteAll, Transpose:=True
        For Each c In .Cells
            If c.MergeCells Then
                With c.MergeArea
                    .UnMerge 'défusionne
                    .Cells = .Cells(1)
                End With
            End If
        Next c
        .Cells.HorizontalAlignment = xlCenter 'centragz
        Range(.Cells(1, -1), .Cells).Borders.Weight = xlThin
        Range(.Cells(1, -1), .Cells).BorderAround Weight:=xlMedium
    End With
Next n
[A1].Select
End Sub

 

[nadem0068]

Bonjour à tous,

ci-joint la solution que j'ai trouvé pour compter les activités dans des cellules fusionnées.
Merci à tous pour votre implication.

bon dimanche.

 

[TooFatBoy]

ci-joint la solution que j'ai trouvé pour compter les activités dans des cellules fusionnées.

Ah ? Le but était de compter les activités ?!?

Ça aurait été sympa de le dire dès le départ, on aurait fait d'autres propositions que celles qu'on a données.

 

[job75]

Bon sang que votre solution du post #13 est compliquée et laborieuse !!!

Elle a au moins l'avantage de nous montrer ce que vous voulez obtenir.

Alors voyez ce fichier (3) et cette macro :

Sub Compter()
Dim d As Object, dd As Object, P As Range, ncol%, i&, x$, j%, c As Range, n%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Set dd = CreateObject("Scripting.Dictionary")
dd.CompareMode = vbTextCompare 'la casse est ignorée
Set P = [C2:G21]
ncol = P.Columns.Count
For i = 1 To P.Rows.Count
    x = P(i, 0)
    For j = 1 To ncol
        Set c = P(i, j).MergeArea(1)
        If c <> "" And P(i, j).Column = c.Column Then
            d(c.Value) = ""
            dd(x & c) = dd(x & c) + 1 'comptage
        End If
Next j, i
n = d.Count
'---restitution---
With [I2] '1ère cellule de destination
    If n Then
        .Resize(n) = Application.Transpose(d.keys)
        For i = 1 To n
            For j = 2 To 5
                .Cells(i, j) = dd(.Cells(0, j) & .Cells(i, 1))
        Next j, i
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 5).ClearContents 'RAZ en dessous
End With
End Sub

Elle utilise 2 Dictionary et je reconnais qu'elle n'est pas très facile à comprendre.

On ne défusionne pas.