Macro pour regrouper des données suivant des critères

[Spacepak]

Bonjour à tous,

Je me permets de vous demander de l'aide pour une macro VBA.
Veuillez trouver le fichier Test en pj.

En fait j'aimerai pouvoir renseigner dans une des deux barres de recherche (Recherche par produit / recherche par entreprise) un nom de produit ou un nom d'entreprise.

L'objectif de la macro est de regrouper toutes les données correspondantes suivant différentes vues. (j'ai bien expliqué sur le fichier excel en pj).
J'ai volontairement limité les barres de recherche à 6 éléments mais en vrai il ne devrait pas y avoir de date limite. Donc en fait si on recherche deux produits, il devrait y avoir par exemple pour la vue 1, deux colonnes qui se créent, etc.

Pourriez-vous m'aider à créer cette macro svp?

(Si quelqu'un pourrait me donner de l'aide en utilisant également des objets / dictionnaires ou autre, je serai également très content, mais ce n'est pas obligatoire )

Merci par avance pour votre aide.

 

[zebanx]

Bonjour,

Je me lance partiellement sur ta demande en constatant qu'il n'a pas eu de réponses, sur un sujet intéressant.

Ce qui me surprend c'est que les 3 tableaux correspondent :
- pour le premier à un transposé du premier tableau
- pour les tableaux 2 et 3 à des tableaux croisés dynamiques

Je les ai organisés comme tel.
Pour le tableau 1, SOMMEPROD devrait suffire. La plage irait chercher les informations en haut dans les produits que tu références.

Pour les TCD, je ne sais pas comment lui dire d'aller chercher la plage à "déselectionner" à partir d'un array.

Si un spécialiste des codes VBA sur les pivotitems passe par là, je serai content qu'il modifie ce code et l'en remercie par avance.

Ci-joint le fichier de travail.

Cdlt
thiery


Code :
Sub TCD_enlever_02()
' bloque
j = Array([F2], [G2], [H2])
For k = LBound(j) To UBound(j)
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
"Entreprise")
.PivotItems(j(k)).Visible = True 'erreur 1004
End With
Next k
End Sub

 

[Bebere]

bonsoir
un code pour le 1er cas,pour dictionary il faut cocher la case de microsoft scripting runtime dans menu outils,références

Sub Bouton1_Cliquer()

    a = Feuil3.Range("A2:C" & Feuil3.Range("A65536").End(xlUp).Row)
    produit = Feuil1.Range("C1:H1")
    Entreprise = Feuil1.Range("C2:H2")
    Feuil1.Range("C7:E9").ClearContents
    Set d = New Dictionary
    k = 2
    For i = 1 To UBound(produit, 2)
        If produit(1, i) <> "" Then
            For j = 1 To UBound(a, 1)
                If produit(1, i) = a(j, 1) Then
                    d(a(j, 1) & "-" & a(j, 3)) = d(a(j, 1) & "-" & a(j, 3)) + a(j, 2)
                End If
            Next j
        End If
    Next i

    For Each x In d.Keys
        k = k + 1
        Feuil1.Cells(7, k) = Mid(x, 1, InStr(x, "-") - 1) 'produit
        Feuil1.Cells(9, k) = Mid(x, InStr(x, "-") + 1) 'entreprise
    Next x

    Feuil1.Range("C8").Resize(, d.Count) = d.Items 'prix
End Sub

 

[Spacepak]

Bonjour!

Je vous remercie pour votre retour et votre aide. Je commence à tester vos solutions!

Bebere : juste une question : comment puis-je faire pour adapter votre code dico pour la 3ème vue (vue par entreprise)?

Je vous remercie par avance.

 

[Bebere]

Bonjour
au lieu de prendre produit tu prends entreprise
ds la boucle i tu inverses la concaténation
tu adaptes k,etc
touche F8 pour lancer le code pas à pas et tu regardes ds la fenêtre variables locales que tu auras afficher

 

[Spacepak]

Bonjour,

J'ai effectivement fais ça et ça marche!
Je vous remercie à tous les deux pour votre aide!

 

[zebanx]

Bonjour Spacepak, bonjour Bebere et le forum

J'ai trouvé sur un site un code précieux qui a été réadapté pour l'occasion.

Dans le fichier joint :
- feuille de saisie
- feuille de synthèse BDD

1. somme prod -> indique le total par produit et fait un récapitulatif des entreprises ayant acheté le produit suivant 2 méthodes.
Le code de Bebere est surement la réponse attendue, ce sera donc un complément

2. tableau croisé (x2 = TCD1 et TCD2)
Mis en forme qui doit ressemble à votre demande (à vous de faire glisser les champs pour les organiser) avec une macro qui vient désormais prendre uniquement pour les entreprises celles que vous avez sélectionner en ligne 2
La source du tableau est automatiquement actualisé, pour chacun, avec le tableau saisie (x lignes mais 3 colonnes pour le moment). A vous de modifier le champ à partir du nom (=tablesource) si vous en avez besoin
=DECALER(saisie!$A$1;;;NBVAL(saisie!$A:$A);NBVAL(saisie!$A$1:$C$1))

Bonne journée, cdlt
thierry

 

[Spacepak]

Bonjour Zebanx et Bebere,

Merci pour votre aide, Je vais en prendre note pour les premières vues!


J'ai rajouté une nouvelle variante dans la 2 ème vue : Recherche par groupe.
(jai pris soin de rajouter les termes sur le fichier Excel dans Menu et Produit).

Bebere : j'ai essayé d'appliquer le code dico pour cette vue là malheureusement je n'arrive qu'à afficher les différentes entreprises pour le groupe recherché. Mais j'aimerai afficher pour chaque entreprise du groupe, leurs produits associés.
J'ai essayé du coup de modifier les clés et les valeurs mais j'avoue que je patauge un peu.
Auriez-vous une piste?

Je vous remercie par avance.

 

[gosselien]

Bonjour,

as tu essayé:

Sub TCD_enlever_02()
j = Array([F2], [G2], [H2])
For k = LBound(j) To UBound(j)
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Entreprise")
        .PivotItems(k).Visible = True
    End With
Next k
End Sub

P.

 

[Spacepak]

Bonjour gosselien,

Oui j'ai testé mais j'ai également une erreur à ".PivotItems(k).Visible = True".

J'aimerai essayer également de passer par des dicos (ou même module de classe) ,pour la 2ème vue ,pour avoir plus de possibilité concernant la "présentation" des résultats.

 

[gosselien]

Bonjour gosselien,

Oui j'ai testé mais j'ai également une erreur à ".PivotItems(k).Visible = True".

Pas chez moi ...

 

[Spacepak]

J'ai pourtant c/c votre code et ça me fait "Impossible de lire la propriété PivotItems de la classe PivotField"

Pourriez-vous envoyer votre version du fichier?

 

[gosselien]

Bin c'est celui du post #8 et le code que j'ai mis au post #9 sans plus

(XL2010)

 

[zebanx]

Bonsoir à tous

@gosselien
Hello ,
J'ai trouvé un code qui fonctionne (#7) et je n'arrivais pas à faire fonctionner le tien comme spacepak.
J'ai contourné le problème en désélectionnant tout (FALSE) et en remettant les correspondances à chaque PIVOTITEMS (TRUE). Et là ça fonctionne.
++

@Spacepak
Cf. post #7.
Chaque TCD se met à jour au lancement de la macro TCD_enlever (ie : en décochant les non-correspondances de la ligne 2).

Le code qui permet de déselectionner dans un TCD (renommés TCD1 et TCD2 sur la SH "BDD")
++
---------------
Sub TCD_enlever()
j = Array([B2], [C2], [D2], [E2], [F2], [G2])

With ActiveSheet.PivotTables("TCD1").PivotFields( _
"Entreprise")
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = False
For k = LBound(j) To UBound(j)
If .PivotItems(i).Value = j(k) Then
.PivotItems(i).Visible = True
Else
End If
Next k
Next i
End With

With ActiveSheet.PivotTables("TCD2").PivotFields( _
"Entreprise")
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = False
For k = LBound(j) To UBound(j)
If .PivotItems(i).Value = j(k) Then
.PivotItems(i).Visible = True
Else
End If
Next k
Next i
End With

End Sub

 

[Bebere]

bonjour
un code pour groupe

Sub UnGroupe()
    Dim a, d As New Dictionary, L As Long, Groupe As String, clé As String


    a = Feuil3.Range("A2:D10") ' & Feuil3.Range("A65536").End(xlUp).Row)
    produit = Feuil1.Range("C1:H1")
    Entreprise = Feuil1.Range("C2:H2")
    Feuil1.Range("J7:M10").ClearContents
    Groupe = Feuil1.[C3]
    For j = 1 To UBound(a, 1)
        If a(j, 4) = Groupe Then d(a(j, 3) & "-" & a(j, 1)) = d(a(j, 3) & "-" & a(j, 1)) + a(j, 2)
    Next
    L = 6
    With Feuil1
        .Cells(7, "J") = Groupe
        For Each clé In d.Keys    'Items
            L = L + 1
            .Cells(L, "K") = Mid(clé, 1, InStr(clé, "-") - 1)    'entreprise
            .Cells(L, "L") = Mid(clé, InStr(clé, "-") + 1)    'produit
            .Cells(L, "M") = d.Item(clé): .Cells(L, "M").NumberFormat = "0.00 €"
        Next clé
    End With

End Sub