XL 2010 Condenser les données d'un tableau

Dranreb

XLDnaute Barbatruc
Ben y a qu'à prévoir un tableau supplémentaire.
TSp() par exemple (SP comme suivi paiement) avec LSp As Long pour son numéro de ligne courant, qu'on incrémente à chaque nouvelle feuille, en faisant juste après TSp(Lsp, 1) = NomFeui, et dans la boucle For Each Détail on fait TSp(LSp, 2) = TSp(Lsp, 2) + Détail(8). À la Fin on met les formules.
 

FCMLE44

XLDnaute Occasionnel
Bonjour

J'ai modifié le code comme suit
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, 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
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", "Montant déclaré"): 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
      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
         TSp(LSp, 1) = NomFeui
         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
            TSp(LSp, 2) = TSp(LSp, 2) + Détail(8)
            TCd(LCd, 5) = TCd(LCd, 5) + Détail(34)
            TCd(LCd, 8) = TCd(LCd, 8) + Détail(38)
Et cela ne fonctionne pas. Je dois faire quelquechose d'incorrect

Cordialement
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Je ne vois pas de Redim TSp(… pour lui attribuer des dimensions ni d'incrémentation de LSp pour avancer dedans.
De plus il me semble que TSp(LSp, 1) = NomFeui, trop bas, sera fait plus souvent que nécessaire, à chaque paquet de lignes aux critères tous pareils au lieu d'une fois seulement par CodeSiret/NumSiret.
Si j'ai bien compris ce que vous vouliez faire, ça doit en quelque sorte un peu marcher en même temps que TRc(LRc… plutôt qu'en même temps que TCd(LCd… sauf que LSp ne doit être incrémenté qu'une fois contrairement à LRc qui doit avancer de 5 au bout du compte à chaque fois.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
C'est bien ce qu'il me semblait. Faites comme ça, donc. Mettez LSp = LSp + 1: TSp(LSp, 1) = NomFeui avant For Each CodCot In NumSiret.Co
Et ajoutez d'abord: , TSp(1 to… derrière le Redim TRc comme on a fait plus bas pour TCd derrière le ReDim TDt. Vous pouvez même ajouter LSp = 0 derrière, si vous voulez, par simple souci d'homogénéité, mais ça ne sert à rien: il est à 0 par défaut au départ du moment qu'on ne s'en est pas servi auparavant pour autre chose.
 

FCMLE44

XLDnaute Occasionnel
voici ce que ca donne si j'ai bien compris
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, 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): LSp = 0
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", "Montant déclaré"): 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
         For Each Détail In Commune.Co
            LDt = LDt + 1
            For C = 1 To 37: TDt(LDt, C) = Détail(C): Next C
            TSp(LSp, 2) = TSp(LSp, 2) + Détail(8)
            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)"
      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
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
Pour le format tel que je le souhaite dois je faire comme récap
 

Dranreb

XLDnaute Barbatruc
Oui, si vous voulez. Et n'oubliez pas de verser le contenu du tableau TSp dans des cellules, c'est à dire de l'affecter à la propriété Value d'un Range de l'objet Worksheet représentant votre feuille de suivi de règlements
 

FCMLE44

XLDnaute Occasionnel
Bonjour

Si je mets FPaiemt.[A1:H1001].Value = TSp, ne faut il pas que j'aille renseigner des éléments ailleurs ?

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, 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):
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 + 2: TSp(LSp, 2) = 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
            TSp(LSp, 2) = TSp(LSp, 2) + Détail(8)
            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)"
      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.[A1:H1001].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
Apparemment ca ne fonctionne pas
 

Dranreb

XLDnaute Barbatruc
Bonjour
Qu'est ce qui ne marche pas ?
Vérifiez à la rubrique Microsoft Excel Objets dans l'explorateur de projet si "FPaiemt" est il bien le nom que vous avez tapé dans la fenêtre de propriété de l'objet Worksheet qui représente la bonne feuille Excel.
 

FCMLE44

XLDnaute Occasionnel
Merci c'est fait
Par contre le montant total de la colonne AU de chaque onglet ne remonte pas
et le format ne fonctionne pas malgré que j'ai modifié comme suit

VB:
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
      With Fpaiemt.Cells(LSp, 1).Resize(, 29): .Font.Bold = True: .Interior.Color = RGB(255, 240, 186): End With
      With Fpaiemt.Cells(LSp, 1).Resize(1):   .Font.Bold = True: .Interior.Color = RGB(255, 240, 186): End With
 

Dranreb

XLDnaute Barbatruc
Le mieux c'est de le cumuler indépendament dans une colonne de TSp. Il y a assez d'exemples de cumuls, non ?
Pourquoi vous mettez .Resize(1) ? Ça ne sert à rien, Fpaiemt.Cells(LSp, 1) ne représente déjà qu'une seule ligne, il n'y a pas lieu de le redimensionner à 1 ligne !

Êtes vous sûr de ne pas confondre le numéro de ligne et le numéro de colonne quand vous modifiez un élément de TSp ?
 

FCMLE44

XLDnaute Occasionnel
Bonjour

Merci. Je fais des progrés mais je suis paumé

Sur la feuille Paiement, j'ai bien les onglets qui s'affichent signe que j'avance mais je ne vois pas du tout comment ramené le montant global par onglet en colonne B

Pouvez vous m'aider ?

Merci
 

Dranreb

XLDnaute Barbatruc
En colonne B ?
Alors dans la boucle for each Détail:
TSp(LSp, 2) = TSp(LSp, 2) + Détail(38)
Mais ça va planter parce que plus haut vous y avez déjà mis NomFeui, en colonne 2 (B)
…du moins dans le code cité au #130
Ça doit déjà planter d'ailleurs parce que vous faitezs aussi déjà TSp(LSp, 2) = TSp(LSp, 2) + Détail(8)
Vous voulez décidément mettre plein de chose à la fois dans cette colonne 2 !
 
Dernière édition:

FCMLE44

XLDnaute Occasionnel
Voilà ce que j'ai fait pour mes différentes demandes et cela fonctionne

Rapatriement du montant
VB:
LSp = LSp + 1: TSp(LSp, 1) = NomFeui
Calcul du total et des écarts

VB:
 Fpaiemt.Cells(LSp + 1, "AA").FormulaR1C1 = "=SUM(RC3:RC26)"
      Fpaiemt.Cells(LSp + 1, "AB").FormulaR1C1 = "=SUM(RC2-RC27)"
Il me reste à régler mon problème de format
 

FCMLE44

XLDnaute Occasionnel
Bonjour

J'avance doucement dans mon projet et je souhaiterais créer en plus une feuille Taux AT qui se présente comme exemple en pièce jointe

Les taux seraient listés par colonne pour chaque code de siret

Voici ce que j'ai fait dans le même principe que ma feuille Suivi paiement

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, 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
      'With FRat.Cells(LAt, 1).Resize(, 8): .Font.Bold = True: .Interior.Color = RGB(255, 240, 186): End With
      'With FRat.Cells(LAt, 1).Resize(4):   .Font.Bold = True: .Interior.Color = RGB(255, 240, 186): End With
      'With Fpaiemt.Cells(LSp, 1).Resize(, 29): .Font.Bold = True: .Interior.Color = RGB(255, 240, 186): End With
      'With Fpaiemt.Cells(LRc, 1).Resize(1):   .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"
      'LAt = LAt + 1: TAt(LAt, 1) = "Montant": TAt(LAt + 1, 1) = "Dads": TAt(LAt + 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
      'LAt = LAp + 1: TAt(LAt, 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, 2) = TAt(LAt, 2) + Détail(36)
            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
'FRat.[A2:B1001].Value = TAt
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
A mon avis comme je mets LAt ca prend par ligne mais je souhaiterais par colonne
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
Bonjour.
Vous n'avez pas encore compris que pour accéder à un élément de tableau VBA à 2 dimensions le 1er indice c'est le numéro de ligne, en le 2nd le numéro de colonne ?
 

FCMLE44

XLDnaute Occasionnel
Bonjour

J'essaie de comprendre certaines choses et j'y arrives pour certaines mais de là à comprendre tout ?

Auriez-vous une idée à me donner ?
 

Discussions similaires


Haut Bas