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 ?
 

Discussions similaires


Haut Bas