XL 2010 Condenser les données d'un tableau

Dranreb

XLDnaute Barbatruc
Indiquez comme indices des expressions numériques représentant dans l'ordre la ligne puis la colonne.
 

Dranreb

XLDnaute Barbatruc
Par exemple, si vous vous débrouillez comme un grand
pour qu'une variable LAt As Long contienne un numéro de ligne
et qu'une autre variable CAt As Long contienne un numéro de colonne,
TAt(LAt + 1, CAt) = TAt(LAt + 1, CAt) + Détail(25) additionnerait un montant colonne 25 à la ligne qui suit celle contenue dans LAt et à la colonne CAt .
 

FCMLE44

XLDnaute Occasionnel
Bonjour

J'ai fait ca
VB:
Private Sub Worksheet_Deactivate()
Dim PlgDon As Range, Titres1(), Titres2(), CodSiret As SsGr, NumSiret As SsGr, F As Long, NomFeui As String, FDest As Worksheet, _
    TDt(), LDt As Long, TCd(), LCd As Long, TRc(), LRc As Long, TSp(), LSp As Long, TAt(), LAt As Long, CAt As Long, CodCot As SsGr, Qualif As SsGr, TxCoti As SsGr, _
    TxAtT23003 As SsGr, LibCot As SsGr, Commune As SsGr, C As Long, Détail As Variant, DicRécap As New Dictionary, CléRécap$
Me.Cells(1, 38).Value = "M_COTIS Corrigé"
Set PlgDon = Me.UsedRange
If PlgDon.Rows.Count < 2 Then Exit Sub
Application.ScreenUpdating = False
Titres1 = PlgDon.Rows(1).Value: Titres2 = PlgDon(1, 30).Resize(, 8).Value
Set PlgDon = PlgDon.Rows(2).Resize(PlgDon.Rows.Count - 1)
PlgDon.Columns(38).FormulaR1C1 = "=IF(RC35=0,RC37,ROUND(RC34*(RC35+RC36)/100,0))"
With ThisWorkbook.Worksheets: For F = FSiret1.Index To .Count: .Item(F).Name = .Item(F).CodeName: Next F: End With
F = FSiret1.Index - 1
TRc = Intersect(FRécTab.[A2:G1000000], FRécTab.UsedRange).Value
For LRc = 1 To UBound(TRc, 1): DicRécap(TRc(LRc, 1) & "|" & TRc(LRc, 2) & "|" & TRc(LRc, 3)) = TRc(LRc, 4): Next LRc
LRc = 0
ReDim TRc(1 To 1000, 1 To 8): LRc = 0
ReDim TSp(1 To 1000, 1 To 8):
ReDim TAt(1 To 1000, 1 To 8):
For Each CodSiret In Gigogne(PlgDon.Rows(2).Resize(PlgDon.Rows.Count - 1), 1, 2, 31, 33, 35, 36, 30, 32)
   For Each NumSiret In CodSiret.Co
       NomFeui = CodSiret.Id & "-" & Right$(String$(5, Chr$(133)) & CStr(NumSiret.Id), 5)
      With ThisWorkbook.Worksheets: If F = .Count Then .Item(F).Copy After:=.Item(F)
         F = F + 1: Set FDest = .Item(F): FDest.Name = NomFeui: End With
      LRc = LRc + 1: For C = 1 To 8: TRc(LRc, C) = Choose(C, NomFeui, "Brut SS", "SS Plaf", _
         "Base CSG", "Net Imposable", "Cice", "Chômage", "Apprentis"): Next C
      With FRécap.Cells(LRc, 1).Resize(, 8): .Font.Bold = True: .Interior.Color = RGB(255, 240, 186): End With
      With FRécap.Cells(LRc, 1).Resize(4):   .Font.Bold = True: .Interior.Color = RGB(255, 240, 186): End With
      LRc = LRc + 1: TRc(LRc, 1) = "Montant": TRc(LRc + 1, 1) = "Dads": TRc(LRc + 2, 1) = "Ecart"
      ReDim TDt(1 To 5000, 1 To 37), TCd(1 To 3000, 1 To 8): LDt = 0: LCd = 0
      LSp = LSp + 1: TSp(LSp, 1) = NomFeui
      CAt = CAt + 1: TAt(CAt, 1) = NomFeui
      For Each CodCot In NumSiret.Co: For Each Qualif In CodCot.Co: For Each TxCoti In Qualif.Co: For _
         Each TxAtT23003 In TxCoti.Co: For Each LibCot In TxAtT23003.Co: For Each Commune In LibCot.Co
         LCd = LCd + 1
         TCd(LCd, 1) = LibCot.Id: TCd(LCd, 2) = CodCot.Id: TCd(LCd, 3) = Commune.Id
         TCd(LCd, 4) = Qualif.Id: TCd(LCd, 6) = TxCoti.Id: TCd(LCd, 7) = TxAtT23003.Id
         For Each Détail In Commune.Co
            LDt = LDt + 1
            For C = 1 To 37: TDt(LDt, C) = Détail(C): Next C
            TAt(LAt + 1, CAt) = TAt(LAt + 1, CAt) + Détail(25)
            TSp(LSp, 2) = TSp(LSp, 2) + Détail(38)
            TCd(LCd, 5) = TCd(LCd, 5) + Détail(34)
            TCd(LCd, 8) = TCd(LCd, 8) + Détail(38)
            CléRécap = Détail(30) & "|" & Détail(31) & "|" & Détail(33)
            If DicRécap.Exists(CléRécap) Then C = DicRécap(CléRécap): TRc(LRc, C) = TRc(LRc, C) + Détail(34)
            Next Détail, Commune, LibCot, TxAtT23003, TxCoti, Qualif, CodCot
      FDest.[A1:AL1].Value = Titres1
      FDest.[AN1].Value = "TABLEAU RECAPITULATIF"
      FDest.[AO1].Value = NomFeui
      FDest.[A2:AL5001].Value = TDt
      FDest.[AN3:AU3].Value = Titres2
      FDest.[AN4:AU3003].Value = TCd
      FDest.Cells(LCd + 5, "AU").FormulaR1C1 = "=SUBTOTAL(9,R4C:R[-2]C)"
      Fpaiemt.Cells(LSp + 1, "AA").FormulaR1C1 = "=SUM(RC3:RC26)"
      Fpaiemt.Cells(LSp + 1, "AB").FormulaR1C1 = "=SUM(RC2-RC27)"
      FDest.Columns.AutoFit
      FDest.[A:AM].Columns.Hidden = True
      TRc(LRc + 1, 1) = "Dads": TRc(LRc + 2, 1) = "Ecart"
      LRc = LRc + 3
      Next NumSiret, CodSiret
FRécap.[A1:H1001].Value = TRc
Fpaiemt.[A2:B1001].Value = TSp
For LRc = 4 To LRc Step 5: FRécap.Cells(LRc, 2).Resize(, 7).FormulaR1C1 = "=R[-2]C-R[-1]C": Next LRc
With ThisWorkbook.Worksheets
   While .Count > F: Application.DisplayAlerts = False: .Item(.Count).Delete
      Application.DisplayAlerts = True: Wend: End With
End Sub
Et cela bug sur

VB:
TAt(LAt + 1, CAt) = TAt(LAt + 1, CAt) + Détail(25)
????
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Allez en débogage et vérifiez les valeurs de LAt et de CAt, elles sont peut être mal initialisées et en dehors des dimensions du tableau
De fait je ne vois aucune incrémentation de CAt à chaque fois qu'il faut ouvrir une nouvelle colonne. (juste après un de For Each In je suppose)
Ah, si, il y en a une, trop haut je crois, au début de chaque code SIRET. Là c'est LAt qui devrait être incrémenté et CAt seulement remis au début…
 
Dernière édition:

FCMLE44

XLDnaute Occasionnel
Voilà ce que j'ai fait mais ca bloque toujours

VB:
For Each CodSiret In Gigogne(PlgDon.Rows(2).Resize(PlgDon.Rows.Count - 1), 1, 2, 31, 33, 35, 36, 30, 32)
   For Each NumSiret In CodSiret.Co
       NomFeui = CodSiret.Id & "-" & Right$(String$(5, Chr$(133)) & CStr(NumSiret.Id), 5)
      With ThisWorkbook.Worksheets: If F = .Count Then .Item(F).Copy After:=.Item(F)
         F = F + 1: Set FDest = .Item(F): FDest.Name = NomFeui: End With
      LRc = LRc + 1: For C = 1 To 8: TRc(LRc, C) = Choose(C, NomFeui, "Brut SS", "SS Plaf", _
         "Base CSG", "Net Imposable", "Cice", "Chômage", "Apprentis"): Next C
      With FRécap.Cells(LRc, 1).Resize(, 8): .Font.Bold = True: .Interior.Color = RGB(255, 240, 186): End With
      With FRécap.Cells(LRc, 1).Resize(4):   .Font.Bold = True: .Interior.Color = RGB(255, 240, 186): End With
      LRc = LRc + 1: TRc(LRc, 1) = "Montant": TRc(LRc + 1, 1) = "Dads": TRc(LRc + 2, 1) = "Ecart"
      ReDim TDt(1 To 5000, 1 To 37), TCd(1 To 3000, 1 To 8): LDt = 0: LCd = 0
      LSp = LSp + 1: TSp(LSp, 1) = NomFeui
      For Each CodCot In NumSiret.Co: For Each Qualif In CodCot.Co: For Each TxCoti In Qualif.Co: For _
         Each TxAtT23003 In TxCoti.Co: For Each LibCot In TxAtT23003.Co: For Each Commune In LibCot.Co
         LCd = LCd + 1
         TCd(LCd, 1) = LibCot.Id: TCd(LCd, 2) = CodCot.Id: TCd(LCd, 3) = Commune.Id
         TCd(LCd, 4) = Qualif.Id: TCd(LCd, 6) = TxCoti.Id: TCd(LCd, 7) = TxAtT23003.Id
         CAt = CAt + 1
         TAt(CAt, 1) = LibCot.Id: TAt(CAt, 2) = CodCot.Id: TAt(CAt, 3) = Commune.Id
         TAt(CAt, 4) = Qualif.Id: TAt(CAt, 6) = TxCoti.Id: TAt(CAt, 7) = TxAtT23003.Id
         For Each Détail In Commune.Co
            LDt = LDt + 1
            For C = 1 To 37: TDt(LDt, C) = Détail(C): Next C
            TAt(LAt + 1, CAt) = TAt(LAt + 1, CAt) + Détail(25)
            TSp(LSp, 2) = TSp(LSp, 2) + Détail(38)
            TCd(LCd, 5) = TCd(LCd, 5) + Détail(34)
            TCd(LCd, 8) = TCd(LCd, 8) + Détail(38)
            CléRécap = Détail(30) & "|" & Détail(31) & "|" & Détail(33)
            If DicRécap.Exists(CléRécap) Then C = DicRécap(CléRécap): TRc(LRc, C) = TRc(LRc, C) + Détail(34)
            Next Détail, Commune, LibCot, TxAtT23003, TxCoti, Qualif, CodCot
      FDest.[A1:AL1].Value = Titres1
      FDest.[AN1].Value = "TABLEAU RECAPITULATIF"
      FDest.[AO1].Value = NomFeui
      FDest.[A2:AL5001].Value = TDt
      FDest.[AN3:AU3].Value = Titres2
      FDest.[AN4:AU3003].Value = TCd
      FDest.Cells(LCd + 5, "AU").FormulaR1C1 = "=SUBTOTAL(9,R4C:R[-2]C)"
      Fpaiemt.Cells(LSp + 1, "AA").FormulaR1C1 = "=SUM(RC3:RC26)"
      Fpaiemt.Cells(LSp + 1, "AB").FormulaR1C1 = "=SUM(RC2-RC27)"
      FDest.Columns.AutoFit
      FDest.[A:AM].Columns.Hidden = True
      TRc(LRc + 1, 1) = "Dads": TRc(LRc + 2, 1) = "Ecart"
      LRc = LRc + 3
      Next NumSiret, CodSiret
FRécap.[A1:H1001].Value = TRc
Fpaiemt.[A2:B1001].Value = TSp
FAt.[A2:Z1001].Value = TAt
 

Dranreb

XLDnaute Barbatruc
Vous avez vérifié au moment du plantage la valeur de CAt en mettant notamment un espion dessus ?
Vous oubliez de le remettre à 1 à chaque fois que vous avancez (trop peu d'ailleurs) dans LAt. Et dans la première ligne de chaque paquet vous ne mettez rien ?
Comme TAt(LAt, CAt) = Qualif.Id par exemple ? (en supposanrt que le CAt = CAt + 1 soit fait juste après le For Each Qualif In…
 

FCMLE44

XLDnaute Occasionnel
J'essaie de comprendre mais je n'y arrive pas trop. Je vous remercie de passer du temps à m'aider mais c'est mon dernier morceau et je veux absolument au bout

Pouvez- vous me dire où et ce qu'il faut que j'écrive pour en finir

Merci
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
Encore novice ?
Avec tous les exemples à étudier…
Puis d'abord je ne sais même pas ce que vous voulez y mettre dans vos lignes jaunes et vos lignes rose: il n'y a toujours qu'une feuille dans le classeur que vous joignez.
Ce qui va dans la jaune ça correspond bien à l'Id d'un des SsGr ?
Si oui, juste après le For Each CeSsGrLà In LeSsGrPrécédent.Co vous faites CAt = CAt + 1 puis TAt(LAt, CAt) = CeSsGrLà.Id pour ouvrir et mettre cet Id en titre de la nouvelle colonne. C'est pas difficile, bon sang !
Ça marche un peu comme le TRc(LRc, C) sauf que le C est calculé différemment et d'après ce que l'ai compris il avancerait plutôt un peu comme les L… des autre rapports, alors il ne faut pas prendre C mais CAt qui sera conservé entre les différents passages de boucles. N'oubliez pas de le remettre CAt = 1 à chaque fois que vous commencez un nouveau paquet de lignes en ajoutant au total 4 ou 5 à LAt comme on le fait pour LRc.
 
Dernière édition:

FCMLE44

XLDnaute Occasionnel
Oui desole j'essaie mais je suis encore novice.
Je pense que vous n'avez pas compris ce que je souhaite faire

Sur la feuille DSN j'ai mis en couleur les donnees a reprendre sur la feuille AT
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
C'est bien ce que je disais, la colonne 36 c'est TxAtT23003.Id, non ?
Mais peut être qu'il faudrait prévoir le
For Each TxAtT23003 en tête de ceux qui suivent le For Each NumSiret, je ne sais pas.
Il se peut aussi que l'ordre des éléments de la collection ne convienne pas pour ce rapport là, auquel cas il faudrait le faire à part. À vérifier… La question à se poser c'est : est ce que ce serait gênant que les lignes des feuilles par SIRET soient classées d'abord par TX_AT_TRANS_23_003 ?
 
Dernière édition:

Discussions similaires


Haut Bas