Regrouper des champs de tableau croisé dynamique sous VBA

[NateD]

Bonjour à tous,

Ceci est mon deuxième topic sur ce forum donc j'espère que je ne commettrai pas de bourde et je vous prie d'être indulgent si ma question n'est pas claire.

Contexte
Dans le cadre d'un stage, j'ai pour travail d'essayer d'automatiser la création de rapport ppt donnant les résultats d'une enquête de satisfaction client.
La grande majorité des graphes sont préparés sous Excel 2003 en version anglaise.

J'ai commencé a créer des macros a partir d'un fichier de réponse et je butte sur la création automatique d'un tableau croisé dynamique.
Je n'ai aucunement une formation d'informaticien et j'ai du apprendre un peu sur le tas (merci l'enregistreur de macro et les différents tuto trouvés en ligne) le VBA.

Problème


Mon soucis est grosso modo expliqué dans le fichier joint, mais en voici un résumé.

Vous y verrez deux macro (car c'est comme ca que je suis organisé dans mon vrai fichier).
La première crée le Tableau croisé dynamique de base et la deuxième s'appuie dessus pour en créer un autre.

Mon problème se situe au niveau de la deuxième macro.

Le but est d'arriver a créer 3 groupes pour catégoriser les clients en fonction des notes qu'ils donneront à la question NPS.
Un groupe avec les clients qui mettent des notes de 0 à 6
Un groupe avec les clients qui mettent les notes 7 ou 8
Un groupe avec les clients qui mettent les notes 9 ou 10

Ces groupes sont fixés ainsi et ceci ne changera jamais.
En revanche, le problème est qu'en fonction de l'enquête je n'aurai pas toujours chacune des notes (le fichier avec les réponses ne sera pas toujours le meme).
Dans l'exemple je n'ai pas mis de 7, mais ca pourrait etre d'autre.

Je ne sais pas s'il est possible d'écrire du code qui soit dirait :
*regroupe tous les objets inférieurs ou égal à 6*, etc..
ou alors
*creer groupe 1, verifier présence objet 0 -> 6, ajouter au groupe*

Je vous remercie d'avance pour votre aide. J'ai fait appel a deux personnes de formation informatique et ils n'ont pu m'aider alors j'espere qu'il y a une solution.

Bonne journée,

 

[tototiti2008]

Re : Regrouper des champs de tableau croisé dynamique sous VBA

Bonjour NateD,

est il possible d'automatiser l'ajout d'un champ dans ta Feuil1 ?
Il faudrait faire une formule en colonne F par exemple du type

en F2

=SI(OU(C2="";C2="N/A");"";RECHERCHEV(C2;{0."Groupe 1";7."Groupe 2";9."Groupe 3"};2))

à recopier jusqu'en bas

 

[NateD]

Re : Regrouper des champs de tableau croisé dynamique sous VBA

L'idée est bonne mais le fait est que sur ma feuill1, il n'y aura jamais le même nombre de lignes vu que le fichier est destiné a être réutilisé pour chaque nouvelle enquête. Le fait de recopier jusqu'en bas ne va donc pas etre automatisé.

Si je passe par VBA, c'est justement pour éviter d'avoir a recourir à ce genre de manip.

Par contre si vraiment je n'y arrive pas, j'utiliserai ca, merci pour l'idee.

 

[tototiti2008]

Re : Regrouper des champs de tableau croisé dynamique sous VBA

Re,

Oui mais en VBA il est possible de détecter quelle est la dernière ligne remplie
Par exemple

Sub NouveauChamp()
Dim Ligne as long
With thisworkbook.worksheets("Sheet1")
Ligne = .range("A65536").end(xlup).row
.range("F1").value = "Groupe"
.range("F2:F" & Ligne).formular1c1 = "=IF(OR(RC[-3]="""",RC[-3]=""N/A""),"""",VLOOKUP(RC[-3],{0,""Groupe 1"";7,""Groupe 2"";9,""Groupe 3""},2))"
end with
end sub

Après il reste à automatiser le TCD sur la liste avec le champ Groupe...

 

[NateD]

Re : Regrouper des champs de tableau croisé dynamique sous VBA

Je te remercie bien, je vais essayer de procéder avec ca !

 

[Pierrot93]

Re : Regrouper des champs de tableau croisé dynamique sous VBA

Bonjour,

une autre approche :

Sub test()
Dim c As Range, p As Range, p2 As Range, p3 As Range, t() As Variant, i As Byte
t = Array(0, 7, 9, 11)
For i = 1 To 3
    For Each c In ActiveSheet.PivotTables(1).PivotFields("NPS").DataRange
        If c >= t(i - 1) And c < t(i) Then If p Is Nothing Then Set p = c Else Set p = Union(p, c)
    Next c
    If p.Count > 1 Then p.Group
    Set p = Nothing
Next i
End Sub

bon après midi
@+