Tableaux dans vba

[akni]

Bonjour,
J'ai un tableau des quantités vendues par articles, clients et mois, je veux faire une récap par client sans passer par TCD quand j'utilise la méthode FOR NEXT elle tarde un peu, je crois qu'avec les tableaux Ubound et Lbound le résultat sera rapide.
ci joint mon fichier avec la macro FOR NEXT.


Merci beaucoup pour toute aide.

 

[Dranreb]

Je ne sais pas. J'ai bien du mal à comprendre comment tu peux en venir à devoir faire des rapport si compliqués qui ne reprennent que certaines données.
Il y a là à mon avis une méthodologie de fond à revoir.
En tout cas il n'est pas possible avec les méthodes du SsGr de sommer toutes les 1ères lignes d'un ensemble de SsGr qui lui sont attachés. Il faut le faire par une boucle.

 

[KIM]

Voilà comment je traite ce rapport (voir resultat dans Feuil FR6), macro FR6_OP_RTparCAT_vok()
sans utiliser les ItemSsGR.
Est-il possible de réduire ce code en intégrant les conditions avec ItemSsGR ?

Bonne soirée
KIM

For Each OP In Gigogne(LOt, nC_OP, nC_DR, nC_SIT, nC_BAT)  
    For C = 4 To CFin: TotOP(C) = 0: Next C
    L = L + 1
    TS(L, 1) = "Total " & OP.Id
    TS(L, 2) = OP.Count
    For Each DR In OP.Co
        TS(L, 4) = TS(L, 4) + DR.Count 'Nb SITE
      For Each SIT In DR.Co
            TS(L, 5) = TS(L, 5) + SIT.Count  'nb BAT
        For Each BAT In SIT.Co
            TS(L, 10) = TS(L, 10) + BAT.Co(1)(nC_SHON)
            TS(L, 12) = TS(L, 12) + BAT.Co(1)(nC_SUB)
            TS(L, 13) = TS(L, 13) + BAT.Co(1)(nC_SUN)
            TS(L, 14) = TS(L, 14) + BAT.Somme(nC_SUB)
       
            If Right$(BAT.Id, 1) = "0" Then
                TS(L, 6) = TS(L, 6) + 1
                Détail = BAT.Co(1)
                If Détail(nC_RT) = "app" Then TS(L, 7) = TS(L, 7) + 1  '
                If Détail(nC_RT) = "spp" Then TS(L, 8) = TS(L, 8) + 1  '
            End If
            For Each Détail In BAT.Co
               If Détail(nC_RT) = "app" Then
                TS(L, DicTit(Détail(ColTitre))) = TS(L, DicTit(Détail(ColTitre))) + Détail(nC_SUB)
               End If
               If Détail(nC_RT) = "spp" Then
                TS(L, DicTit(Détail(ColTitre)) + DicTit.Count + 1) = TS(L, DicTit(Détail(ColTitre)) + DicTit.Count + 1) + Détail(nC_SUB)
               End If
            Next Détail

        Next BAT
        Next SIT
     Next DR

 

[KIM]

Bonjour Dranreb,
1/ Je traite des extractions de différentes bases de données.
Avec certaines extractions je dois mettre 0 dans les cases vides pour qu'une macro fonctionne et avec d'autres extractions, la meme macro fonctionne avec les cases vides.
Comment je peux dire que toutes les cellules vides ou avec espace du tableau LOt = FBaseU.ListObjects(1) soient initialisées à Empty ?

2/ Dans ton post 241 du 11 avril tu dis :
Il y a aussi la possibilité de préfiltrer l'ensemble. Mais ça je crois que je ne t'en ai jamais parlé...
Comment faire pour l'exploiter ?

Merci d'avance
KIM

 

[Dranreb]

Bonjour.
1) — Pas bien compris la question. En principe il n'y a que les formules qu'Excel s'obstine à rendre incapables de renvoyer Empty comme valeur de cellule. Cela dit la comparaison avec "" marche.
2) — Il faut affecter à LignesÀFiltrer = TL une table de Long à 1 dimension contenant les numéros de lignes à considérer de la source. La Sub IndexerParFusions s’appuie alors sur cette table au lieu de s'en constituer une comportant tous les numéros de ligne. La fonction Gigogne appelle cette Sub. Aussi désactive-t-elle ce pré-filtrage après avoir constitué la collection.

 

[KIM]

Re bonjour,
1/ je vais tester la comparaison avec "".
2/ As-tu un exemple traitant le pré-filtrage?
Merci d'avance
KIM

 

[Dranreb]

Je n'ai pas d'exemple de pré-filtrage sous la main.
À ma connaissance ça n'a jamais été utilisé.
Mais il y a un début à tout, n'est ce pas.

Dans la fourniture pour les ComboBox liées il y a un dispositif analogue, avec en plus une méthode qui fabrique la table de Long en ne retenant que les lignes d'une certaine valeur précisée dans une certaine colonne, non attribuée alors en principe à une ComboBox gérée. Il n'y a qu'à s'en inspirer :

Public Sub Filtrer(ByVal Colonne As Variant, ByVal Valeur)
Dim VCol(), L As Long, N As Long
CorrigerColonne Colonne, "Filtrer": VCol = PlgTablo.Columns(Colonne).Value
ReDim TLgnFlt(1 To UBound(VCol, 1))
For L = 1 To UBound(VCol, 1)
   If VCol(L, 1) = Valeur Then N = N + 1: TLgnFlt(N) = L
   Next L
ReDim Preserve TLgnFlt(1 To N): Préfiltré = True: CBM_Change TCBM(1)
End Sub

 

[KIM]

Bonsoir Dranreb et le forum,
Je reviens vers toi pour m'aider car je galère depuis ce matin.
La col PHASE a été définie comme titres de colonne.
Je calcule pour chaque phase le nombre d'EQP Principal
Dans la col EQP_EXT, l'EQP principal se termine par "0" et on rajoute ensuite 1, 2, etc pour chaque mise à jour sur cet équipement
Pour l'EQP EQP100, c'est l'EQP principal de l'EQP10
Pour EQP101, c'est la 1è mise à jour de cet EQP.
Dans la col BUD il y a le budget pour l'EQP principal et aussi pour les mises à jour.
J'arrive à calculer le nombre d'EQP principal par PHASE sans problème en faisant un test sur If Right$(Détail(nC_EQPx), 1) = "0" Then etc;
ci-joint le fichier
Je dois maintenant sortir le nombre d'EQP principal par PHASE quand le BUD de l'EQP principal et ses mises à jour dépassent 2000.
Merci d'avance de m'aider à résoudre cette demande.
Cordialement
KIM

Sub RecapParPhase_v3()
Dim DicTit As Dictionary, L As Long, C As Long, TRés(1 To 500, 1 To 12), _
   Dpt As SsGr, Serv As SsGr, Site As SsGr, Eqp As SsGr, Phase As SsGr, EqpX As SsGr, Détail
Dim ColDep As Long
'Recherche les entetes des colonnes pour identifier le numero de la colonne.
Dim nC_PHASE&, nC_LibEQP&, nc_ETAT&, nC_BUD&, nC_NOT&, nC_DPT&, nC_SERV&, nC_SITE&, nC_EQP&, nC_EQPx&
Dim LOt As ListObject
Set LOt = FDonn.ListObjects(1)
nC_PHASE = NColTab(LOt, "PHASE")
nC_LibEQP = NColTab(LOt, "Lib EQP")
nc_ETAT = NColTab(LOt, "ETAT")
nC_BUD = NColTab(LOt, "BUD")
nC_NOT = NColTab(LOt, "NOT")

nC_DPT = NColTab(LOt, "DPT")
'nC_SERV = NColTab(LOt, "SERV")
nC_SITE = NColTab(LOt, "SITE")
nC_EQP = NColTab(LOt, "EQP_Principal")
nC_EQPx = NColTab(LOt, "EQP_EXT")

Set DicTit = GigIdx.DicInvent(LOt, nC_PHASE, 9)
ColDep = 10
L = 1
For C = 1 To 7: TRés(L, C) = Choose(C, "DPT", "EQP_Principal", "EQP_Avec_Ext", "Nbr EQP", "Nbr ??", "Nbr EQP ok", "BUD"): Next C
VerserTitres TRés, DicTit
'Stop
'For Each Dpt In GigIdx.Gigogne(Null, "DPT", "SERV", "SITE", "EQP")
For Each Dpt In GigIdx.Gigogne(Null, nC_DPT, nC_EQP)
    L = L + 1
    TRés(L, 1) = Dpt.ID
    TRés(L, 2) = Dpt.Count 'nbr d'Eqp Principal
   For Each Eqp In Dpt.Co
    TRés(L, 3) = TRés(L, 3) + Eqp.Count  'nbr d'Eqp Principal avec ext
    TRés(L, 4) = TRés(L, 4) + Eqp.Co(1)(nC_BUD)
    TRés(L, 5) = TRés(L, 5) + Eqp.somme(nC_BUD)

        For Each Détail In Eqp.Co
            If Right$(Détail(nC_EQPx), 1) = "0" Then
                TRés(L, DicTit(Détail(nC_PHASE))) = TRés(L, DicTit(Détail(nC_PHASE))) + 1
            End If
        Next Détail, Eqp, Dpt

FDonn.[A32].Resize(500, 12).Value = TRés
End Sub

 

[Dranreb]

Bonsoir.
Je n'arrive pas trop à suivre.
Il s'agit de ne pas sortir les lignes où Eqp.somme(nC_BUD) <=2000 ?
Il peut être possible de mettre Empty toutes les colonnes TRès(L, … puis de faire L = L - 1 si la condition est détectée à la fin.

 

[KIM]

Bonjour Dranreb,
Mon problème c'est le test à faire sur le cumul de BUD pour un EQP avec ses mises à jour et comptabiliser cet équipement si ce cumul est > 2000.
Dans la col EQP_EXT, les lignes EQP100 et EQP101 correspondent à un seul EQP EQP10 et le cul de BUD = somme BUD de ces 2 lignes.
Pour un EQP donné il peut y avoir 1, 2 ou plusieurs lignes à sommer et à tester le cumul de BUD pour comptaliser cet EQP.
Je n'ai plus de ressources, Merci de ton aide. Peut être la logique du code n'est pas adaptée.
KIM

 

[Dranreb]

Décomposez alors.
VTemp = Eqp.somme(nC_BUD)
If VTEmp > 2000 then TRés(L, 5) = TRés(L, 5) + VTemp
Vous devriez d'ailleurs aussi décomposer pour éviter 2 consultations de Dictionary
Au lieu de TRés(L, DicTit(Détail(nC_PHASE))) = TRés(L, DicTit(Détail(nC_PHASE))) + 1
faites : C = DicTit(Détail(nC_PHASE)): TRés(L, C) = TRés(L, C) + 1

 

[KIM]

Merci!!!
Selon tes préconisations et pour avoir le nombre d'EQP dont BUD>2000 et aussi par PHASE ci-dessous le code utilisé.

    VTemp = Eqp.somme(nC_BUD)
        If VTemp > 3500 Then
            TRés(L, 6) = TRés(L, 6) + VTemp
            TRés(L, 7) = TRés(L, 7) + 1
        End If
       
        For Each Détail In Eqp.Co
            If Right$(Détail(nC_EQPx), 1) = "0" Then
              If VTemp > 3500 Then
                C = DicTit(Détail(nC_PHASE)): TRés(L, C) = TRés(L, C) + 1
              End If
            End If
        Next Détail, Eqp, Dpt

Je vais le tester sur mon fichier de données réelles.
Merci encore
KIM

 

[KIM]

Re bonjour Dranreb,
Je regroupe dans un tableau de synthése le budget BUD par EQP principal. Ci-dessous un code très light.

Sub Regroup2()
Dim TS(), DPT As SsGr, EQPp As SsGr, EQPx As SsGr, LS&, SIT As SsGr
ReDim TS(1 To Feuil1.UsedRange.Rows.Count, 1 To 5)
For Each DPT In Gigogne(Feuil1.[A5:E5], 1, 3)
   For Each EQPp In DPT.Co
         LS = LS + 1
         TS(LS, 1) = DPT.ID
         TS(LS, 2) = EQPp.ID
         TS(LS, 3) = EQPp.Somme(5): Next EQPp, DPT
Feuil1.[A25].Resize(UBound(TS, 1), 5).Value = TS
End Sub

Je recopie cette synthese dans Feuil1 à partir de A25Le tableau résultat TS

Pour continuer de travailler avec le même tableau des données d'origine, Je souhaite dans une colonne supplémentaire du tableau des données A5:E5, injecter le cumul des BUD pour chaque EQP et seulement au niveau de la 1è occurence de l'EQP. Est-ce possible ? et si oui comment?
Voir fichier ci-joint.
Merci encore
KIM

 

[Dranreb]

Ça ne va pas marcher deux fois de suite si les données ne sont pas dans un tableau et que tu ajoute le résultat derrière : Ce que tu aura ajouté sera inclut à la Feuil1.UsedRange !
Là je crains qu'il ne faille plutôt réécrire tout le tableau de données car il risque en principe de ne pas être classé au départ par DPT et EQPp. Reproduire chaque ligne détail mais sortir le cumul d'abord. Quelque chose comme ça en somme :

Sub Regroup2()
Dim TS(), DPT As SsGr, EQPp As SsGr, EQPx As SsGr, LS&, SIT As SsGr, Détail, C As Long
ReDim TS(1 To Feuil1.UsedRange.Rows.Count, 1 To 6)
For Each DPT In Gigogne(Feuil1.[A5:E5], 1, 3)
   For Each EQPp In DPT.Co
      TS(LS + 1, 6) = EQPp.Somme(5)
      For Each Détail In EQPp.Co
         LS = LS + 1
         For C = 1 To 5: TS(LS, C) = Détail(C): Next C, Détail, EQPp, DPT
Feuil1.[A5].Resize(UBound(TS, 1), 6).Value = TS
End Sub

 

[KIM]

Bonsoir,
J'ai modifié ton code sans réécrire tout le tableau des données. J'ai eu le bon résultat. La logique est-elle correcte ? Quelles sont les risques sur un tableau de milliers de lignes et plus de 50 col ?

Sub Regroup4()
Dim TS(), DPT As SsGr, EQPp As SsGr, EQPx As SsGr, LS&, SIT As SsGr, Détail, C As Long
ReDim TS(1 To Feuil1.UsedRange.Rows.Count, 1 To 6)
For Each DPT In Gigogne(Feuil1.[A5:E5], 1, 3)
   For Each EQPp In DPT.Co
      TS(LS + 1, 1) = EQPp.Somme(5)
      For Each Détail In EQPp.Co
         LS = LS + 1
    Next Détail, EQPp, DPT
Feuil1.[F5].Resize(UBound(TS, 1), 1).Value = TS
End Sub

Merci d'avance
KIM

 

[Dranreb]

Comme dit, il n'y a pas de garantie que le tableau de données soit classé dans l'ordre assumé par la fonction Gigogne.
Donc en écrivant juste la colonne 5 on risque des décalages dans les lignes.