Tableau croisé dynamique

[Dadou99]

Bonjour,

J'ai un fichier qui contient 4 colonnes :
- Numéro référence Facture
- Nom hôpital Facture
- Numéro référence Décision
- Nom hôpital Décision

J'ai donc deux colonnes qui contiennent des références (Facture et Décisions).
Certains numéros peuvent se retrouver dans une colonne ou les deux.
Pour chaque numéro de référence, il y a un nom d'hôpital. Si la même référence se trouve dans les deux colonnes de références, le nom de l'hôpital est le même

J'aimerais réalisé un tableau croisée dynamique, via une macro, afin d'obtenir le résultat qui se trouve dans le fichier joint. J'espère avoir été assez clair dans mes explications, mais si jamais, l'exemple est relativement simple à comprendre.

Après plusieurs heures de recherche et tentatives, j'ai réellement besoin d'un coup de pouce afin de trouver une solution.

Merci pour votre aide précieuse !

 

[Misange]

Re : Tableau croisé dynamique

Bonsoir
Tu ne peux pas obtenir ce que tu veux sans réorganiser tes données de départ.
Un exemple ci-joint. Pas besoin de macro pour créer un TCD 🙂

 

[Dadou99]

Re : Tableau croisé dynamique

Merci pour ta réponse et tes éléments de solutions.

Penses-tu qu'il est possible de générer un tableau, via du code vba, pour arriver à atteindre le résultat souhaité (comme montré dans mon fichier) ?

 

[ROGER2327]

Re : Tableau croisé dynamique

Bonjour à tous.


Re :

(...)
Penses-tu qu'il est possible de générer un tableau, via du code vba, pour arriver à atteindre le résultat souhaité (comme montré dans mon fichier) ?

Un essai vite fait dans le classeur joint.​

Option Explicit

'¤ Ajouter la référence à la bibliothèque Microsoft Scripting Runtime (scrrun.dll) au projet ! ¤'

Sub toto()
Dim i&, j&, t(), RF(), RD(), RFD As New Scripting.Dictionary, Plg As Range '
  RF = [RFac].Value 'plage de données =Feuil1!$A$2:$B$6
  RD = [RDéc].Value 'plage de données =Feuil1!$C$2:$D$8
  With RFD '
    For i = 2 To UBound(RF) '
      If Not .Exists(RF(i, 1)) Then .Add RF(i, 1), Array(RF(i, 2), "X", Empty) '
    Next '
    For i = 2 To UBound(RD) '
      If .Exists(RD(i, 1)) Then .Item(RD(i, 1)) = Array(RD(i, 2), "X", "X") Else .Add RD(i, 1), Array(RD(i, 2), Empty, "X") '
    Next '
    ReDim t(.Count - 1, -1 To 2) '
    For i = 0 To .Count - 1: t(i, -1) = .Keys(i): For j = 0 To 2: t(i, j) = .Items(i)(j): Next j, i '
  End With '
  Set Plg = Feuil2.[A2].Resize(i, 4) 'plage de résultats
    Plg.Value = t '
    With Plg.Parent '
      With .Sort '
        .SortFields.Clear '
        .SortFields.Add Key:=Plg(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal '
        .SetRange Plg '
        .Header = xlNo '
        .MatchCase = False '
        .Orientation = xlTopToBottom '
        .SortMethod = xlPinYin '
        .Apply '
    End With '
    .Activate
  End With '
End Sub

 

[Dadou99]

Re : Tableau croisé dynamique

Super !! Merci beaucoup...

Toutefois, il y a une modification souhaitée 😡

En effet, je dois ajouter 4 colonnes (1 dans Facture et 3 dans Décisions)
Toutefois, le principe reste le même. Il suffit d'ajouter ces données dans le tableau de résultat.

Comme je suis novice, j'avoue n'avoir pas trop compris votre code, surtout dans la boucle "with" et j'ai donc du mal à modifier le code en conséquence.

Je vous joins un second exemple qui cette fois ne changera plus.
En jaune, ce sont les colones ajoutées.

Encore merci pour votre précieuse aide !!

 

[ROGER2327]

Re : Tableau croisé dynamique

Re...

(...)
Toutefois, il y a une modification souhaitée 😡
(...)

Yes! Very mad!​

(...)
En effet, je dois ajouter 4 colonnes (1 dans Facture et 3 dans Décisions)
Toutefois, le principe reste le même. Il suffit d'ajouter ces données dans le tableau de résultat.
(...)

Hum...​

(...)
Comme je suis novice, j'avoue n'avoir pas trop compris votre code, surtout dans la boucle "with" et j'ai donc du mal à modifier le code en conséquence.
(...)

La structure​

With Objet
'Code
End With

n'est pas une boucle. Elle sert à alléger l'écriture d'un code. Par exemple (classement d'un plage Plg par ordre croissant des valeurs de sa première colonne) :​

With Plg.Parent '
  With .Sort '
    .SortFields.Clear '
    .SortFields.Add Key:=Plg(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal '
    .SetRange Plg '
    .Header = xlNo '
    .MatchCase = False '
    .Orientation = xlTopToBottom '
    .SortMethod = xlPinYin '
    .Apply '
  End With '
.Activate '
End With '

peut s'écrire sans With ... End With :​

Plg.Parent.Sort.SortFields.Clear '
Plg.Parent.Sort.SortFields.Add Key:=Plg(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal '
Plg.Parent.Sort.SetRange Plg '
Plg.Parent.Sort.Header = xlNo '
Plg.Parent.Sort.MatchCase = False '
Plg.Parent.Sort.Orientation = xlTopToBottom '
Plg.Parent.Sort.SortMethod = xlPinYin '
Plg.Parent.Sort.Apply '
Plg.Parent.Activate '

C'est relou, comme dirait ma petite-fille.​

(...)
Je vous joins un second exemple qui cette fois ne changera plus.
(...)

Bonne nouvelle ! Car si, comme disait ma grand-mère, faire et défaire, c'est toujours travailler, c'est assez lassant.
Ma grand-mère parlait mieux le céfran que ma petite-fille... Mais là n'est pas la question.

Faisons-le tout de même. Il faut modifier les plages de données, modifier la structure des items du dictionnaire, modifier quelques indices de-ci de-là. Profitons-en pour ajouter quelques précautions comme, par exemple, éviter un plantage pour le cas (improbable, mais sait-on jamais ?) où le dictionnaire serait vide, et quelques autres bricoles.

Il vient :​

Sub toto()
Dim i&, j&, t(), RF(), RD(), RFD As New Scripting.Dictionary, Plg As Range '
  RF = [RFac].Value 'plage de données =Feuil1!$A$2:$C$5
  RD = [RDéc].Value 'plage de données =Feuil1!$D$2:$H$7
  With RFD '
    For i = 2 To UBound(RF) '
      If Not IsEmpty(RF(i, 1)) Then If Not .Exists(RF(i, 1)) Then .Add RF(i, 1), Array(RF(i, 2), RF(i, 3), Empty, Empty, "X", Empty) '
    Next '
    For i = 2 To UBound(RD) '
      If Not IsEmpty(RD(i, 1)) Then '
        If .Exists(RD(i, 1)) Then '
          .Item(RD(i, 1)) = Array(RD(i, 2), RD(i, 3), RD(i, 4), RD(i, 5), "X", "X") '
        Else '
          .Add RD(i, 1), Array(RD(i, 2), RD(i, 3), RD(i, 4), RD(i, 5), Empty, "X") '
        End If '
      End If '
    Next '
    ReDim t(.Count + (.Count <> 0), -1 To 5)  '
    For i = 0 To .Count - 1: t(i, -1) = .Keys(i): For j = 0 To 5: t(i, j) = .Items(i)(j): Next j, i '
  End With '
  Set Plg = Feuil2.[A2].Resize(i - (i = 0), 7) 'plage de résultats
  Plg.CurrentRegion.Offset(1).ClearContents
  Plg.Value = t '
  With Plg.Parent '
    With .Sort '
      .SortFields.Clear '
      .SortFields.Add Key:=Plg(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal '
      .SetRange Plg '
      .Header = xlNo '
      .MatchCase = False '
      .Orientation = xlTopToBottom '
      .SortMethod = xlPinYin '
      .Apply '
    End With '
  .Activate '
  End With '
  Plg(1).Offset(-1).Select 'Facultatif
End Sub

Voyez le classeur joint...​

Bonne nuit !


ℝOGER2327
#7103

Mercredi 11 Décervelage 141 (Saint Eustache, libérateur - fête Suprême Quarte)
19 Nivôse An CCXXII, 1,3067h - marbre
2014-W02-3T03:08:10Z

 

[Dadou99]

Re : Tableau croisé dynamique

Merci, merci et encore merci !!!!!