XL 2016 DATA VBA

[Maths_Excel]

Bonjour à tous,

J'ai une base de données avec 20 000 lignes. L'objectif pour moi est de grouper les valeurs ayant en commun : un Identifiant, puis de générer un identifiant lié au groupe créé.

Merci d'avance.

 

[Maths_Excel]

Bonsoir Dranreb,

J'ai encore avancé sur mon projet, mais je n'arrive à faire correspondre les noms des sociétés et le nombre des associés.

Pourriez-vous me donnez encore quelques pistes ?

Merci d'avance.

Option Explicit
Private Sub Worksheet_Activate()
Dim Données As Collection, Soc As SsGr, TTrv(), LMax As Long, TotCA As Currency, Détail, L As Long, C As Long, _
   PCA As SsGr, NGrp As Long, IDP As SsGr, TRés(), Grp As SsGr, TJoin() As String, N As Long, Nom As SsGr, Nsoc As SsGr
Set Données = GigIdx.Gigogne(Feuil2.[A2:F2], -6, 4)
For Each PCA In Données: LMax = LMax + PCA.Nombre: Next PCA
ReDim TTrv(1 To LMax, 1 To 8)
For Each PCA In Données
   For Each Soc In PCA.Co
      NGrp = NGrp + 1
      For Each Détail In Soc.Co
         L = L + 1: For C = 1 To 6: TTrv(L, C) = Détail(C): Next C
         TTrv(L, 8) = NGrp: Next Détail, Soc, PCA
L = 0
For Each IDP In GigIdx.Gigogne(TTrv, 1, Null, 4)
   NGrp = IDP.Co(1)(8)
   For Each Détail In IDP.Co
      L = L + 1: For C = 1 To 6: TTrv(L, C) = Détail(C): Next C
      TTrv(L, 8) = NGrp: Next Détail, IDP
L = 0
For Each Soc In GigIdx.Gigogne(TTrv, 4, Null, 1)
   NGrp = Soc.Co(1)(8)
   For Each Détail In Soc.Co
      L = L + 1: For C = 1 To 6: TTrv(L, C) = Détail(C): Next C
      TTrv(L, 8) = NGrp: Next Détail, Soc
L = 0
Set Données = GigIdx.Gigogne(TTrv, 8, Null, -3, 1)
ReDim TRés(1 To Données.Count, 1 To 6)
For Each Grp In Données
   L = L + 1
   TRés(L, 1) = Grp.Co(1)(1)
   TRés(L, 3) = Grp.Co(1)(3)
   Next Grp
L = 0
For Each Grp In GigIdx.Gigogne(TTrv, 8, 2)
   L = L + 1: ReDim TJoin(1 To Grp.Count): N = 0
   For Each Nom In Grp.Co: N = N + 1: TJoin(N) = Nom.Id: Next Nom
   TRés(L, 2) = Join(TJoin, vbLf)
   TRés(L, 6) = Grp.Count: Next Grp
L = 0
For Each Grp In GigIdx.Gigogne(TTrv, 8, Null, -6)
   L = L + 1
   TRés(L, 4) = Grp.Co(1)(4): Next Grp

L = 0
For Each Grp In GigIdx.Gigogne(TTrv, 8, 6)
   L = L + 1: TotCA = 0
   For Each Soc In Grp.Co: TotCA = TotCA + Soc.Co(1)(6): Next Soc
   TRés(L, 6) = TotCA: Next Grp
Me.Rows(2).Resize(50000).ClearContents
With Me.[A2].Resize(UBound(TRés, 1), UBound(TRés, 2))
   .Columns(1).NumberFormat = "@"
   .Columns(4).NumberFormat = "0"
   .Value = TRés: End With
End Sub

 

[Dranreb]

Le nombre d'associés c'est bien le nombre de noms partenaires, pas le nombre de sociétés ?
Par ailleurs je n'ai plus très confiance dans le système de regroupement réciproque que j'avais fait.
Regardez ce que j'ai fait.

 

[Maths_Excel]

Dranreb,

Le nombre d'associés c'est bien le nombre de noms partenaires.

Le système de regroupement que vous aviez fait précédemment, me paressais pertinent.

Ce nouveau regroupement est bien ergonomique, et permet d'avoir une vue d'ensemble et grouper. Serait juste possible de rajouter le détail du chiffre d'affaire de chaque société ?

Un merci pour le temps que vous consacrez à ce projet.

Bien cordialement,

 

[Maths_Excel]

Dranreb,

Waouh 😵 ce regroupement est mortel, je l'ai testé avec une grosse basse de donnée. Le résultat est bluffant.

Merci.

 

[Dranreb]

C'est possible de rajouter le détail des chiffres d'affaires, mais en textes et non sous forme de nombres.
Ajouté un TJ3() As String dans les déclarations, corrigé ReDim TRés(1 To Données.Count, 1 To 8) et plus loin TRés(L, 8) = N, et dans le dernier paquet :

For Each Grp In GigIdx.Gigogne(TTrv, 7, -6, 4)
   L = L + 1: N = 0: TotCA = 0
   For Each PCA In Grp.Co: N = N + PCA.Count: Next PCA
   ReDim TJ1(1 To N), TJ2(1 To N), TJ3(1 To N): N = 0
   For Each PCA In Grp.Co
      For Each Soc In PCA.Co
         Détail = Soc.DonnéesDébut
         N = N + 1: TJ1(N) = Soc.Id: TJ2(N) = Détail(5): TJ3(N) = Format(Détail(6), "#,##0.00 €")
         TotCA = TotCA + Détail(6): Next Soc, PCA
   TRés(L, 4) = Join(TJ1, vbLf)
   TRés(L, 5) = Join(TJ2, vbLf)
   TRés(L, 6) = Join(TJ3, vbLf)
   TRés(L, 7) = TotCA: Next Grp

Inséré une nouvelle colonne dans le tableau, en format texte.

 

[Maths_Excel]

Bonjour Dranreb,

Merci, cela fonctionne super bien.

Bien cordialement,