XL 2010 Condenser les données d'un tableau

FCMLE44

XLDnaute Impliqué
Supporter XLD
Bonjour

Etape 2 de mon projet

Les onglets se créant automatiquement en fonction des données de la feuille DSN, je souhaite, pour chaque onglet créé condenser les données obtenues.

Feuille TC :
En ligne 4 colonne AN, je souhaite condenser les données se trouvant en colonne AD à AK (cf exemple fichier joint).

Lors de la mise à jour de chaque onglet via macro Balaye1, il se mettrait à jour automatiquement

Cordialement
 

Pièces jointes

  • DSN ESSAI.xls
    94 KB · Affichages: 51

FCMLE44

XLDnaute Impliqué
Supporter XLD
Si je peux abuser.

Est-il possible que lors de la génération du condensé, nous ayons un total de la colonne AU ?
Est-il possible que les colonnes A à AK se masque automatiquement lors de la génération du condensé ?

Il faut que je puisse démasquer en cas de nécessité

Merci beaucoup

Cordialement
 

Dranreb

XLDnaute Barbatruc
Le code corrigé :
VB:
Option Explicit

Private Sub Worksheet_Deactivate()
Dim PlgDon As Range, CodSiret As SsGr, FDest As Worksheet, TDt(), LDt As Long, _
    TRs(), LRs 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
Set PlgDon = Me.UsedRange
Application.ScreenUpdating = False
If PlgDon.Rows.Count < 2 Then Exit Sub
For Each FDest In ThisWorkbook.Worksheets
   If FDest.Index > 1 Then FDest.Cells.Value = Empty
   Next FDest
For Each CodSiret In Gigogne(PlgDon.Rows(2).Resize(PlgDon.Rows.Count - 1), 1, 31, 33, 35, 36, 30, 32)
   On Error Resume Next: Set FDest = ThisWorkbook.Worksheets(CodSiret.Id)
   If Err Then With ThisWorkbook.Worksheets: .Item(.Count).Copy After:=.Item(.Count): _
      Set FDest = .Item(.Count): FDest.Name = CodSiret.Id: End With
   On Error GoTo 0
   ReDim TDt(1 To 5000, 1 To 37), TRs(1 To 3000, 1 To 8): LDt = 0: LRs = 0
   For Each CodCot In CodSiret.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
      LRs = LRs + 1: TRs(LRs, 1) = LibCot.Id: TRs(LRs, 2) = CodCot.Id: TRs(LRs, 3) = Commune.Id: TRs(LRs, 4) = Qualif.Id
      TRs(LRs, 6) = TxCoti.Id: TRs(LRs, 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
         TRs(LRs, 5) = TRs(LRs, 5) + Détail(34)
         TRs(LRs, 8) = TRs(LRs, 8) + Détail(37): Next Détail
      Next Commune, LibCot, TxAtT23003, TxCoti, Qualif, CodCot
      FDest.[AN1].Value = "CONDENSÉ"
      FDest.[A1:AK1].Value = PlgDon.Rows(1).Value
      FDest.[A2:AK5001].Value = TDt
      FDest.[AN3:AU3].Value = PlgDon(1, 30).Resize(, 8).Value
      FDest.[AN4:AU3003].Value = TRs
      FDest.Cells(LRs + 5, "AU").FormulaR1C1 = "=SUBTOTAL(9,R4C:R[-2]C)"
      FDest.Columns.AutoFit
      FDest.[A:AK].Columns.Hidden = True
   Next CodSiret
End Sub
Remarque: aussi ajouté un bout de code qui nettoie préalablement les cellules des feuilles afin qu'il n'en subsiste de garnie pour un CODE_DE_SIRET disparu des données.

Pièce joint supprimée.
Nouvelle version jointe plus loin.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Oui, c'est possible.
Mais un peu compliqué, a moins d'ajouter un niveau pour la colonne 2 (B), ce qui est sans doute encore le plus simple.
Essayez de le faire vous même pour vous familiariser avec l'algorithme.

Essayez vraiment de le faire, et prenez ensuite seulement le corrigé.
 

Pièces jointes

  • GigogneFCMLE44.xlsm
    88.8 KB · Affichages: 41
Dernière édition:

FCMLE44

XLDnaute Impliqué
Supporter XLD
Bonjour

Merci pour la réponse.
Je pense que la solution se trouve dans cette partie de code mais je ne vois pas comment modifier pour obtenir les chiffres à la place du X

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
      If IsNumeric(NumSiret.Id) Then NomFeui = Format(NumSiret.Id Mod 100000, "00000") _
                                Else NomFeui = Right$(String$(5, "…") & NumSiret.Id, 5)
      NomFeui = CodSiret.Id & "-" & NomFeui
      On Error Resume Next: Set FDest = ThisWorkbook.Worksheets(NomFeui)
      If Err Then With ThisWorkbook.Worksheets: .Item(.Count).Copy After:=.Item(.Count): _
         Set FDest = .Item(.Count): FDest.Name = NomFeui: End With

D'autre part, est il possible de mettre le nom de l'onglet en lieu et place de CONDENSE

Cordialement
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Le nom de l'onglet du coup ce sera NomFeui
Alors mettez NomFeui au lieu de "CONDENSÉ"

C'est marrant, vous n'avez pas l'air de comprendre qu'il y a "…………X" seulement parce que vous n'avez mis que des "X" comme numéros de SIRET dans vos données. C'est une blague ou quoi ?
 
Dernière édition:

Discussions similaires