Lier deux segments de tableau croisé qui n'ont pas la même source

julbute

XLDnaute Junior
bonjour à tous et merci d'avance de vous pencher sur mon soucis.

Voici la configuration :

un classeur comportant plusieurs onglets
- Donnée, comportant la basse de donnée du premier tableau croisé
- Etiquette, comportant la basse de donnée du deuxième tableau croisé
- Analyse
- Tableau croisé "Donnée"
- Tableau croisé "Etiquette"
- Segment "Donnée"
- Segment "Etiquette"

J'aimerai lier les deux segments "Donnée" et "Etiquette", avec Donnée en "Maitre" .Ce que je sélectionne sur "donnée" et sélectionné sur "Etiquette". Les données dans la base "Donnée" sont toujours dans la base "Etiquette", mais pas l'inverse.

J'ai trouvé quelques codes sur le web, mais je n'arrive pas à les adapter.

Roger
 

Fichiers joints

julbute

XLDnaute Junior
Re : Lier deux segments de tableau croisé qui n'ont pas la même source

Bonjour à tous,
j'ai réussi à adapter le code trouvé sur le net. (Merci à l'auteur, sur un autre forum)
Cela fonctionne dans le principe, sauf que lorsque je sélectionne les données sur le segment "Maitre". Le segment "Etiquettte" se mets à jour avec les "Projets" sélectionnés sur "Donnée". Cependant les "projets" ne se trouvant pas dans la base de donnée "donnée" mais dans la base de donné "Etiquette" sont sélectionnés dans le segment "Etiquette".
Je ne suis pas complètemetn novice en VBA, mais je ne connais pas ces instructions et cela me dépasse un peu.
Merci de votre aide.
Roger
 

Fichiers joints

chris

XLDnaute Barbatruc
Re : Lier deux segments de tableau croisé qui n'ont pas la même source

Bonjour

Eviter les MP pour questions techniques, merci.

Code:
Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)

    If Sh.Name = "Analyse" And Target.Name = "Donnée" Then
       
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        ActiveWorkbook.SlicerCaches("Segment_Projet1").ClearManualFilter
        
        For Each Iitem In ActiveWorkbook.SlicerCaches("Segment_Projet").SlicerItems
             ActiveWorkbook.SlicerCaches("Segment_Projet1").SlicerItems(Iitem.Name).Selected = Iitem.Selected
        Next
        
        'Menage
        For Each Iitem In ActiveWorkbook.SlicerCaches("Segment_Projet1").SlicerItems
        Trouve = False
        For Each IItem2 In ActiveWorkbook.SlicerCaches("Segment_Projet").SlicerItems
            If IItem2.Name = Iitem.Name Then
                Trouve = True
                Exit For
            End If
        Next IItem2
        If Trouve = False Then Iitem.Selected = False
        Next Iitem
 
        Application.EnableEvents = True
    End If
End Sub
Edit : plus optimisé avec une seule double boucle
Code:
Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)

    If Sh.Name = "Analyse" And Target.Name = "Donnée" Then
       
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        ActiveWorkbook.SlicerCaches("Segment_Projet1").ClearManualFilter
        
        For Each Iitem In ActiveWorkbook.SlicerCaches("Segment_Projet1").SlicerItems
        Trouve = False
        For Each Iitem2 In ActiveWorkbook.SlicerCaches("Segment_Projet").SlicerItems
            If Iitem2.Name = Iitem.Name Then
                Trouve = True
                Iitem.Selected = Iitem2.Selected
                Exit For
            End If
        Next Iitem2
        If Trouve = False Then Iitem.Selected = False
        Next Iitem
 
        Application.EnableEvents = True
    End If
End Sub
 
Dernière édition:

julbute

XLDnaute Junior
Re : Lier deux segments de tableau croisé qui n'ont pas la même source

Bonjour chris,
Pardonnez moi pour cette "interpellation" par MP!

En tout cas c'est exactement se dont j'ai besoin.
Je vais décortiqué le code afin de le comprendre et le transposé sur mon fichier final.
Merci de votre aide.
Roger
 

julbute

XLDnaute Junior
Re : Lier deux segments de tableau croisé qui n'ont pas la même source

(Re) bonjour,
Cela fonctionne parfaitement bien.
La recherche me parait un peu longue sur le fichier comportant toutes les données.
Pourtant je n'ai que 72 projets.
je me suis servi du code le plus optimisé.

Encore merci.
Roger
 

chris

XLDnaute Barbatruc
Re : Lier deux segments de tableau croisé qui n'ont pas la même source

Bonjour

C'est un peu la limite de ce genre d'exercice : il faut tester chaque valeur de chaque segment en boucle.

Une autre solution est de vérifier dans la source.

Cependant s'il n'y pas plus de 72 projets par segment cela ne devrait pas être perceptible...

As-tu bien mis le Application.ScreenUpdating = False
 

julbute

XLDnaute Junior
Re : Lier deux segments de tableau croisé qui n'ont pas la même source

Bonjour,
la double boucle prend effectivement un peu de temps.
Mais cela me parait un peu long, 3 à 4 secondes...

Application.ScreenUpdating = False est mis comme dans le code et j'ai ajouté Application.ScreenUpdating = True juste avant Application.EnableEvents = True.

Le nombre de projet doit augmenter au fil du temps.
Je m'en accommoderai ...
C'est quand même mieux comme cela que de chercher dans les deux segments la même donnée.
Je ne voie pas comment faire pour avoir mieux.
Roger
 

slaplace

XLDnaute Nouveau
Re : Lier deux segments de tableau croisé qui n'ont pas la même source

Bonjour,

J'ai essayé de le faire fonctionner avec mon tableau mais j'ai bcp de mal à transcrire le code avec mes données.

Pourriez vous me donner un coup de main ?
 

Fichiers joints

bornz

XLDnaute Nouveau
Re : Lier deux segments de tableau croisé qui n'ont pas la même source

Bonjour,

Je dois presque la même chose sauf que moi c'est sur 4 segments et sélectionner le même pays sur les 4 segments.
Par quoi dois-je remplacer "Analyse" et "Donné" et comment faire pour 4 segments dans mon cas, s'il vous plaît ?

Cordialement,
 

julbute

XLDnaute Junior
Re : Lier deux segments de tableau croisé qui n'ont pas la même source

Cela commence à dater un peu tout cela...
Je veux bien jeter un coup d’œil mais sans bout de fichier cela me semble compliqué.

Désolé "Slaplace" le message est passé inaperçu de mon coté... As tu trouvé une solution pour ton fichier depuis le temps ?
 

Monkey

XLDnaute Nouveau
Bonjour,

Je relance ce sujet car je rencontre le même type de problème, et malgré le VBA procuré par Chris, ça ne fonctionne pas...
Voici un lien vers mon fichier (il est assez lourd, beaucoup de données...) : https://aegide-my.sharepoint.com/:x:/g/personal/yann_beneult_domitys_fr/EQ2XQYH3cp5IoP35AT4MUXoBKKFiJTFsOk1n356Lzd220A?e=pgdeOR

Je veux que les segments "Mois" et "Mois2" soient liés, avec Mois en maitre, et Mois2 en esclave.
Pour l'explication, le type de données de ces deux segments n'est pas identique, et après avoir passé une matinée entière à essayer de trouver une solution via PowerPivot (pour mettre en relation mes données de TCD) je sèche complètement...

J'ai reprise le code fourni par Chris, en adaptant à mon tableau.
Quelqu'un pourrait-il revoir cela svp ?

Merci d'avance :)
 

chris

XLDnaute Barbatruc
Bonjour

Le code partant du principe que le TCD est nommé Données cela ne peut fonctionner puisque tu n'as pas nommé tes TCD

Est-il utile d'utiliser le modèles de données PowerPivot (très lourd mais non accerssible pour nous du fait de la protection de ton classeur) ?

Il pourrait être utile selon les données de pré-traiter par PowerQuery...
 

Monkey

XLDnaute Nouveau
Bonjour Chris,

Merci de ta réponse rapide.

J'utilise PowerPivot car j'ai plusieurs bases de données différentes, qui présentent les données sous différentes formes (exemple : "Région" est présente sur quatre bases, mais de manière multiple et non ordonnée). Il a donc fallu que je créé une nouvelle table dédoublonnée et rangée pour ensuite la lier aux autres.

Concernant le code VBA, je suis donc parti là dessus :
Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)

If Sh.Name = "Feuil2" And Target.Name = "Tableau croisé dynamique1" Then

Application.EnableEvents = False
Application.ScreenUpdating = False

For Each Iitem In ActiveWorkbook.SlicerCaches("Segment_Index_Années__mois").SlicerItems
Trouve = False
For Each Iitem2 In ActiveWorkbook.SlicerCaches("Segment_Mois__mois").SlicerItems
If Iitem2.Name = Iitem.Name Then
Trouve = True
Iitem.Selected = Iitem2.Selected
Exit For
End If
Next Iitem2
If Trouve = False Then Iitem.Selected = False
Next Iitem

Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub

Le souci, c'est qu'il bloque à la ligne "For Each Iitem In ActiveWorkbook.SlicerCaches("Segment_Index_Années__mois").SlicerItems".

Pourrais-tu m'expliquer en quoi consiste le code s'il te plait ?

Merci d'avance.
 

chris

XLDnaute Barbatruc
RE

Les Segments de TCD PowerPivot n'ont pas les mêmes propriétés que les ceux des TCD "classiques" notamment pas de SlicerItems

Si c'est juste la relation et pas les mesures PowerPivot alors il est plus simple de pré-traiter avec PowerQuery, ce qui allègera ton classeur et la gestion VBA.

Mais cela oblige à refaire les TCD...
 
Dernière édition:

chris

XLDnaute Barbatruc
RE

Pour mémoire la synchro de segments PowerPivot se fait de cette façon

mais je pense que PowerQuery allégera ton fichier... et permettrait peut-être d'avoir une source unique via les relations...
 
Dernière édition:

Monkey

XLDnaute Nouveau
Bonjour Chris,

J'ai essayé d'utiliser PowerQuery mais je ne vois pas l'intérêt. De plus, mon fichier ayant pour vocation d'être partagé, envoyé par mail, consulté hors connexion... Il me semble plus de maintenir le modèle de données PowerPivot qui est stocké à même le fichier.

Ou alors c'est qu'il y a quelque chose que je ne connais pas !

Concernant le lien que tu m'as donné, j'ai du mal à l'adapter à mon fichier... Etant novice en VBA.

Pourrais-tu m'éclairer sur le sujet ?

Merci d'avance.
 

chris

XLDnaute Barbatruc
Re

PowerQuery ne duplique pas les données : il exploite les donnes à l'intérieur du fichier par requête donc aucun souci de mail (au contraire vu le poids en moins), ni besoin de connexion (comme la connexion au modèle PowerPivot, elle est également interne au classeur).
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas