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.

 

[KIM]

Re bonjour,
J'ai positionné la DR comme un SsGr principal et présenté la synthèse par DR. L'OP devient un SsGr de la DR. Voir fichier ci-joint onglet R31 et macro Synthese_ParOP_DPT_Site_GrouperCol_vR312.
Comment créer un tableau de synthèse du même format par DR sans le reprogrammer à chaque fois ? Voir onglet DPT01.
Je pense que c'est dans la boucle
For Each DR in Gigogne(ColUti(FBase1.[A55]), 1, 10, 2)

Merci d'avance
KIM

 

[Dranreb]

Je n'ai pas ouvert le classeur mais il me semble que le DR n'était pas en 1 puisque c'était le OP qui y était

 

[KIM]

En effet la DR n'était pas en 1, j'ai modifié la macro et le tableau de synthèse pour avoir en 1 la DR, en 2 l'OP et en 3 le site (fichier du #76) :
For Each DR In Gigogne(ColUti(FBase1.[A55]), 1, 10, 2)
For C = 7 To 10: TotDR(C) = 0: Next C
For Each OP In DR.Co
For C = 7 To 10: TotOP(C) = 0: Next C
For Each SITE In OP.Co
...
Merci
KIM

 

[Dranreb]

Il serait préférable de mettre les feuilles par DPT à la fin.
Il faut refaire
ReDim TS(1 To 1000, 1 To 10)
For C = 1 To 10: TS(1, C) = Choose(C, "DPT", "OP", "SITE", "SUB", _
"", "", "A+D+F", "B+C+G", "E", "Total"): Next C
Puis L = 1 pour recommencer au début, à chaque for For Each DR.
Prend exemple sur le GigogneAkni du poste 73: il fait ce qu'il faut pour vider le tableau sur une feuille différente à chaque combinaison des 2 1ers arguments. Toi tu n'en a qu'un, DR, c'est plus simple.

 

[KIM]

Je vais essayer,
Merci
KIM

 

[KIM]

Re bjr Dranreb,
Je me suis inspiré du fichier GigogneAkni du poste 73, j'ai nommé l'onglet DT01 FVent1, J'ai pu créer les onglets par DR, par contre je ne retrouve pas des tableaux corrects par DR. Je pense que certains Next sont mal positionnés.

Merci de ton aide

KIM


Sub Synthese_ParOP_DPT_Site_GrouperCol_vR312()
'Synthese R3
Dim C As Long, TS(), DCols As Dictionary, TSpl() As String, N As Long, L As Long, _
OP As SsGr, TotOP(7 To 10) As Double, DR As SsGr, TotDR(7 To 10) As Double, SITE As SsGr, _
Détail, Statut As String, Montant As Double, NbG(7 To 11) As Long, TotG(7 To 10)
Dim F As Long, FDest As Worksheet, LMax As Long

For F = FVent1.Index To ThisWorkbook.Worksheets.Count
Set FDest = ThisWorkbook.Worksheets(F): FDest.Name = FDest.CodeName: Next F
F = FVent1.Index - 1


ReDim TS(1 To 1000, 1 To 10)
For C = 1 To 10: TS(1, C) = Choose(C, "DPT", "OP", "SITE", "SUB", _
"", "", "A+D+F", "B+C+G", "E", "Total"): Next C
Set DCols = New Dictionary
For C = 7 To 9: TSpl = Split(TS(1, C), "+")
For N = 0 To UBound(TSpl): DCols(TSpl(N)) = C: Next N, C
L = 1


For Each DR In Gigogne(ColUti(FBase1.[A55]), 1, 10, 2)
L = 1
With ThisWorkbook.Worksheets: If F = .Count Then .Item(F).Copy After:=.Item(F)
F = F + 1: Set FDest = .Item(F): End With
FDest.Name = DR.Id
' FDest.Name = "T_" & DR.Id

For C = 7 To 10: TotDR(C) = 0: Next C

For Each OP In DR.Co
For C = 7 To 10: TotOP(C) = 0: Next C
LMax = 0
For Each SITE In OP.Co
LMax = LMax + SITE.Count
L = L + 1
TS(L, 1) = DR.Id
TS(L, 2) = OP.Id
TS(L, 3) = SITE.Id
For Each Détail In SITE.Co
Statut = Détail(16): Montant = Détail(14)
If Not DCols.Exists(Statut) Then MsgBox "Statut """ & Statut & """ non prévu.", vbCritical: Exit Sub
C = DCols(Statut)
TS(L, C) = TS(L, C) + Montant: TS(L, 10) = TS(L, 10) + Montant
NbG(C) = NbG(C) + 1: NbG(10) = NbG(10) + 1: Next Détail
For C = 7 To 10: TotOP(C) = TotOP(C) + TS(L, C): Next C, SITE


L = L + 1: TS(L, 2) = "Total " + DR.Id + " - " + OP.Id

For C = 7 To 10: TS(L, C) = TotOP(C): TotDR(C) = TotDR(C) + TotOP(C): Next C
L = L + 1: Next OP


L = L + 1: TS(L, 1) = "Total " + DR.Id
For C = 7 To 10: TS(L, C) = TotDR(C): TotG(C) = TotG(C) + TotDR(C): Next C
L = L + 1

L = L + 1: TS(L, 1) = "Total"
For C = 7 To 10
TS(L, C) = TotG(C)
TS(L + 1, C) = NbG(C)
Next C
Next DR

FDest.Rows(5).Resize(1000000).ClearContents
FDest.[A5].Resize(L, 10) = TS

End Sub

 

[Dranreb]

Oui, le vidage du tableau doit être fait juste avant Next DR, non plus tout à la fin.
Conseil: évite d'ajouter des lignes vides inutiles dans le code: ça ne facilite ni l'établissement ni le suivi d'une indentation correcte.

 

[KIM]

Bonsoir Dranreb,
Résultat OK, j'ai supprimé les lignes vides par contre j'ai étét obligé de Redim le tableau TS après For Each DR In Gigogne(ColUti(FBase1.[A55]), 1, 10, 2).
1- Comment formater les lignes de Col 1 à col 10 dont je retrouve Total en Col1 ou en Col2 en fond Jaune et gras ?
2-Peut-on optimiser le code ci-dessous ?

Merci encore
KIM


Sub Synthese_ParOP_DPT_Site_GrouperCol_vR312()
'Synthese R3
Dim C As Long, TS(), DCols As Dictionary, TSpl() As String, N As Long, L As Long, _
OP As SsGr, TotOP(7 To 10) As Double, DR As SsGr, TotDR(7 To 10) As Double, SITE As SsGr, _
Détail, Statut As String, Montant As Double, NbG(7 To 11) As Long, TotG(7 To 10)
Dim F As Long, FDest As Worksheet, LMax As Long

For F = FVent1.Index To ThisWorkbook.Worksheets.Count
Set FDest = ThisWorkbook.Worksheets(F): FDest.Name = FDest.CodeName: Next F
F = FVent1.Index - 1

ReDim TS(1 To 1000, 1 To 10)
For C = 1 To 10: TS(1, C) = Choose(C, "DPT", "OP", "SITE", "SUB", _
"", "", "A+D+F", "B+C+G", "E", "Total"): Next C
Set DCols = New Dictionary
For C = 7 To 9: TSpl = Split(TS(1, C), "+")
For N = 0 To UBound(TSpl): DCols(TSpl(N)) = C: Next N, C
' L = 1

For Each DR In Gigogne(ColUti(FBase1.[A55]), 1, 10, 2)
With ThisWorkbook.Worksheets: If F = .Count Then .Item(F).Copy After:=.Item(F)
F = F + 1: Set FDest = .Item(F): End With
FDest.Name = DR.Id

ReDim TS(1 To 1000, 1 To 10)
L = 1
For C = 1 To 10: TS(1, C) = Choose(C, "DPT", "OP", "SITE", "SUB", _
"", "", "A+D+F", "B+C+G", "E", "Total"): Next C

For C = 7 To 10: TotDR(C) = 0: Next C

For Each OP In DR.Co
For C = 7 To 10: TotOP(C) = 0: Next C
LMax = 0
For Each SITE In OP.Co
LMax = LMax + SITE.Count
L = L + 1
TS(L, 1) = DR.Id
TS(L, 2) = OP.Id
TS(L, 3) = SITE.Id
For Each Détail In SITE.Co
Statut = Détail(16): Montant = Détail(14)
If Not DCols.Exists(Statut) Then MsgBox "Statut """ & Statut & """ non prévu.", vbCritical: Exit Sub
C = DCols(Statut)
TS(L, C) = TS(L, C) + Montant: TS(L, 10) = TS(L, 10) + Montant
NbG(C) = NbG(C) + 1: NbG(10) = NbG(10) + 1: Next Détail
For C = 7 To 10: TotOP(C) = TotOP(C) + TS(L, C): Next C, SITE

L = L + 1: TS(L, 2) = "Total " + DR.Id + " - " + OP.Id

For C = 7 To 10: TS(L, C) = TotOP(C): TotDR(C) = TotDR(C) + TotOP(C): Next C, OP

L = L + 1: TS(L, 1) = "Total " + DR.Id
For C = 7 To 10: TS(L, C) = TotDR(C): TotG(C) = TotG(C) + TotDR(C): Next C

L = L + 1: TS(L, 1) = "Nbre Total"
For C = 7 To 10: TS(L, C) = NbG(C): Next C

FDest.Rows(4).Resize(1000000).ClearContents
FDest.[A4].Resize(1000, 10) = TS
For C = 7 To 10: TotG(C) = 0: NbG(C) = 0: Next C
Next DR

End Sub

 

[Dranreb]

Pour chaque DR on peut mettre les police et fond normaux et à chaque fois qu'on écrit des totaux dans TS(L, … changer les formats de FDest.Rows(L + 3)
Il n'y a me semble t-il rien à optimiser. Mais c'est sûr qu'un ReDim TS(1 To 1, 1 To 10) suffirait au début, juste pour la fabrication du DCols.

 

[KIM]

Bonjour Dranreb et le forum,
Pour changer les formats en effet FDest.Rows(L + 3) fonctionne mais pourquoi L+3 ?
Pour finaliser ce tableau de synthèse, comment je peux copier, pour chaque DR, sous le tableau de Synthèse de la DR, les données source de chaque DR à partir de FBase1 (onglet Base2) ?
Merci
KIM

 

[Dranreb]

Bonjour
Parce que comme vous écrivez TS à partir de A4, la ligne 1 du tableau va à la 4 de la feuille. L + 3.
Pas compris la seconde question.

 

[KIM]

Re bonjour,
Je n'avais percuté pour le décalage du début du tableau. Merci.
Les données de toutes les DR sont dans un onglet Base2, de nom FBase1 défini par
For Each DR In Gigogne(ColUti(FBase1.[A5 P5]), 1, 10, 2)
En créant dans un onglet par DR un tableau de synthèse pour la DR, je souhaite recopier sous ce tableau les données brutes de la DR contenues dans FBase1.
voir onglet DT01
Comment faire ?
Merci
KIM

 

[Dranreb]

Ça ne me parait vraiment pas souhaitable de modifier la feuille de données en y ajoutant des choses derrière. Comme il n'y a aucune plage mise sous forme de tableau Excel nulle part, on se base sur tout ce qu'il y a, alors des choses ajoutées derrière en feraient ensuite partie.

 

[KIM]

Re,
Peut-etre ma demande n'est pas claire. Je ne souhaite pas modifier la feuille de données. Je voudrais recopier, de la feuille des données, les données de chaque DR dans son onglet, au dessous du tableau de synthèse qui vient d'être créé pour avoir un onglet complet par DR : La synthèse et les données concernées.
Au lancement de la macro, l'onglet de chaque DR est effacé (ClearContents ou Delete)
Merci encore

KIM

 

[Dranreb]

Ah… Il est possible de réserver un tableau supplémentaire dans lequel on ajoute 1 à sa ligne Ld (d comme détail) à chaque Détail dont on y copie tout par une boucle sur C. Il ne resterait qu'à le verser en FDest.Cells(L + Quelque chose, "A").Resize(Ld, 16), L étant toujours le numéro de ligne jusqu'où on est arrivé dans TS.