Microsoft 365 Création macro Comptabilité double critère synthèse

[KlausCs]

Bonjour à tous,

Je souhaite créer une macro mais je n'arrive pas à trouver la bonne manière de m'y prendre.

En somme, j'ai un fichier comprenant un grand nombre d'onglets. Ces onglets sont ordonnés par produit que ma compagnie vend.
A l'intérieur de chaque onglet, j'ai une colonne qui m'indique le vendeur responsable de la vente sur ce produit (=1 vendeur différent par ligne et par colonne donc), puis une colonne par mois m'indiquant la facturation du mois par produit.

je voudrais à présent ajouter un onglet de synthèse, me permettant d'obtenir directement le total par vendeur par mois.
J'ai donc besoin d'un double critère de recherche (par vendeur et par mois) à l'intérieur d'un très grand nombre d'onglets.

Pour que ce soit plus parlant j'ai créé un faux tableau en PJ, permettant peut-être de mieux comprendre mon problème...

Quelqu'un a une idée de la manière d'aborder ce problème ?

Merci !

 

[R@chid]

Bonjour et Bienvenue sur XLD,
une idée via power Query.
Voir PJ

Cordialement

 

[Lolote83]

Bonjour à tous,
R@chid, j'essaye de reproduire ce que tu as fait via PowerQuery mais je suis dans une impasse.
J'essaye désespérément de me mettre justement à PowerQuery, mais je ne comprends pas comment tu as pu lier les différents onglets.
- As tu un tuto valable ? j'en ai regardé plusieurs sur PowerQuery mais je n'arrive pas à reproduire ce que tu as fais.
Merci et encore bravo
@+ Lolote83

 

[R@chid]

Bonjour Lolote83,
c'est facile mais c'est un peu fastidieux si jamais on aura plusieurs onglet, car il faut mettre toutes les plages dans tous les onglets sous forme de tableaux structurés, après on ouvre une requête vide, et on tape la commande = Excel.CurrentWorkbook() pour importer les tableaux du classeur, une fois que c'est fait, il faut filtrer la liste de ces tableaux et ne prendre que ceux qui commencent par "PROD" dans ce cas.

Mais je pense que la meilleure de façon de faire et d'ouvrir un nouveau classeur, et importer les données d'un classeur qui va être celui présenté par le questionneur, comme ça on va trouver tous les onglets sans avoir besoin de reconstruire toutes les plages et les mettre sous forme de tableaux structurés.


Cordialement

 

[Amilo]

Bonsoir, bonne année et meilleurs vœux à tous,

Dans ce genre de problème, je préfère plutôt utiliser un TCD connecté à une requête Power query.
Je n'ai volontairement pas transformé les plages des produits en un tableau structuré.

L'inconvénient de cette méthode sans tableaux structurés est qu'il ne faut aucune autre cellule ou plage de données quelque part sur la feuille sans rapport à la requête actuelle.

Les requêtes power query sont plus rapides avec des tableaux structurés.

Avec des tableaux structurés, la méthode est la même mais sans les inconvénients cités plus haut

Par ailleurs, les mois apparaissent en texte dans ce fichier, c'est toujours mieux de les indiquer en type "Date". Je ne les ai pas modifiés dans ce fichier.

Sinon, voici une vidéo de démo qui sera automatiquement supprimée après 7 jours

P.S :R@chid, pour info, il me semble que votre proposition avec Power Query n'est pas dynamique, les nouvelles colonnes ne se rajoutent pas à la requête.

Cordialement

 

[R@chid]

Re,

P.S : Pour info, R@chid, il me semble que votre proposition avec Power Query n'est pas dynamique, les nouvelles colonnes ne se rajoutent pas à la requête.

Salut Amilo,
Oui tu as raison, j'y ai pas fait attention à ce que les nouvelles colonnes ne sont pas prises en compte.

 

[cp4]

Bonjour Tout le monde,

@KlausCs : code à tester

Option Explicit
Option Compare Text

Sub Consolidation()
   Dim F As Worksheet, col As Integer, derlig As Long, dercol As Integer
   col = Sheets("produit 1").Cells(3, Columns.Count).End(xlToLeft).Column

   With Sheets("synthese")
      .Cells.Clear
      Sheets("produit 1").Range(Sheets("produit 1").Cells(3, 2), Sheets("produit 1").Cells(3, col)).Copy Destination:=.Range("B3")
   End With

   For Each F In ThisWorkbook.Worksheets
      If F.Name <> "SYNTHESe" Then
         With F
            derlig = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
            dercol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            .Range(.Cells(4, 2), .Cells(derlig, dercol)).Copy _
                  Sheets("synthese").Range("B" & Sheets("synthese").Cells(Rows.Count, 2).End(xlUp).Row + 1)
         End With
      End If
   Next

   With Sheets("synthese")
.activate
      Dim d As Object, TblE, i As Long, lig As Integer, c As Double
      Set d = CreateObject("Scripting.Dictionary")
      TblE = .Range("b3").CurrentRegion
      Dim TblS(): ReDim TblS(1 To UBound(TblE), 1 To UBound(TblE, 2))   ' Table sortie
      For i = LBound(TblE) To UBound(TblE)
         If d.exists(TblE(i, 1)) Then
            lig = d(TblE(i, 1))            ' Récupération index TblS()
         Else
            d(TblE(i, 1)) = d.Count + 1: lig = d.Count: TblS(lig, 1) = TblE(i, 1)
         End If
         For c = 2 To UBound(TblE, 2): TblS(lig, c) = TblS(lig, c) + TblE(i, c): Next c   ' Totalisation numérique
      Next i
      .Range("b3").CurrentRegion.ClearContents
      .[B3].Resize(d.Count, UBound(TblS, 2)) = TblS
   End With
End Sub

Bon week-end à toutes et à tous.