XL 2010 Condenser les données d'un tableau

FCMLE44

XLDnaute Occasionnel
Je prends le risque j'ai beoin de ces données

De même je souhaiterais mettre en forme ma feuille Récapitulatif comme dans ce fichier. Est-ce possible ?
 

Fichiers joints

FCMLE44

XLDnaute Occasionnel
Lorsque je mets ce code
VB:
 CléRécap = Détail(30) & "|" & Détail(31) & "|" & Détail(33)
            If DicRécap.Exists(CléRécap) Then
               ColsRéc = DicRécap(CléRécap)
               C = ColsRéc(0): If C > 1 Then TRc(LRc, C) = TRc(LRc, C) + Détail(38)
               C = ColsRéc(1): If C > 1 Then TRc(LRc, C) = TRc(LRc, C) + Détail(38)
               End If
Le système bugge.
Erreur de compilation
Variable non définie
 

Dranreb

XLDnaute Barbatruc
Ajoutez la déclaration de ColRéc().
Pour les formats, profitez de la boucle For LRc = 4 To LRc Step 5 tout en bas qui met les formules.
Aidez vous de l'enregistreur de macro pour les modèles, moi je suis fatigué.
 

FCMLE44

XLDnaute Occasionnel
J'ai créé cette macro avec le générateur de macros pour mon format
VB:
Sub Format()
'
' Format Macro
'
 
'
    Range("A1:A4,B1:H1,B4:H4").Select
    Range("H4").Activate
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("B3:H3,E2").Select
    Range("E2").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark2
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -4.99893185216834E-02
        .PatternTintAndShade = 0
    End With
    Range("A1:H4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
End Sub
Lorsque je le mets avant la boucle, j'obtiens un débogage
 

Dranreb

XLDnaute Barbatruc
En fait y a qu'une chose à tirer de tout ce fatras : ExpressionRange.Font.Bold = True pour mettre en gras.
Pour mettre en jaune orange pâle je fais : ExpressionRange.Interior.Color = RGB(255, 240, 186)
 

Dranreb

XLDnaute Barbatruc
Non !!! Dedans !
VB:
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
 

FCMLE44

XLDnaute Occasionnel
Merci

Hier soir et afin de m'entrainer à la macro, avec l'aide du générateur, j'ai fait cette macro pour qu'en J1 sur la feuille récap j'ai un TCD automatique qui me donne les données en pièce jointe.

VB:
Sub TCDAT()
'
' TCDAT Macro
'
 
'
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "DSN!R1C1:R6000C38", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Récapitulatif!R1C10", TableName:= _
        "Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion14
    Sheets("Récapitulatif").Select
    Cells(1, 10).Select
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "CODE_DE_SIRET")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "TX_AT_TRANS_23_003")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("M_ASSIETTE_23_004"), _
        "Nombre de M_ASSIETTE_23_004", xlCount
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Nombre de M_ASSIETTE_23_004")
        .Caption = "Somme de M_ASSIETTE_23_004"
        .Function = xlSum
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "CODE_DE_SIRET").Orientation = xlHidden
    ActiveWorkbook.ShowPivotTableFieldList = False
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "TX_AT_TRANS_23_003")
        .PivotItems("0").Visible = False
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").RowAxisLayout xlTabularRow
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect _
        "TX_AT_TRANS_23_003[All]", xlLabelOnly, True
    Columns("J:K").Select
    Selection.Copy
    Range("L1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("J:K").Select
    Range("K1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("J:K").EntireColumn.AutoFit
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$L$2"), , xlYes).Name = _
        "Tableau2"
    Range("Tableau2[[#All],[Colonne1]]").Select
    ActiveSheet.ListObjects("Tableau2").TableStyle = "TableStyleLight9"
    Columns("J:K").Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$J:$K"), , xlYes).Name = _
        "Tableau3"
    Columns("J:K").Select
    ActiveSheet.ListObjects("Tableau3").TableStyle = "TableStyleMedium19"
    Columns("L:L").Select
    Selection.Delete Shift:=xlToLeft
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "DADS"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Ecart"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=+[@[Somme de M_ASSIETTE_23_004]]-[@DADS]"
    Range("Tableau3[[#Headers],[TX_AT_TRANS_23_003]]").Select
End Sub
Je dois faire CTRL f pour le lancer, n'y a t il pas un moyen pour qu'on l'est en même temps que les autres éléments. sI réactive les onglets ca bugge en disant qu'il y a deja un tcd

Avez vous une idée ?
 

Fichiers joints

FCMLE44

XLDnaute Occasionnel
Sur la feuille Récapitulatif aprés tous les petits tableaux par feuille, je souhaiterais en avoir un global qui reprends toutes les feuilles

Comment faire ?
 

Dranreb

XLDnaute Barbatruc
Complètement idiot de refaire des TCD alors qu'on a la fonction Gigogne
Et on ne va quand même pas repartir des feuilles alors que DSN contient tout ce qu'il y a dans les feuilles.
 

FCMLE44

XLDnaute Occasionnel
Oui je sais mais comme j'ai compris le système du générateur de macro, j'ai donc fait mon TCD via la feuille DSN

J'essaie. J'ai le mérite d'essayer mais je savais que vous alliez me dire ça.

Cordialement
 

Dranreb

XLDnaute Barbatruc
Déjà il faut vérifier si la seule collection jusqu'à présent utilisée, fabriquée par cette fonction, ne convient pas déjà. Elle convient si l'ordre de classement et les regroupements nécessaires pour de votre nouveau rapport sont les mêmes. Alors il est possible d'écrire au fur et à mesure ce qu'on rencontre dans un tableau supplémentaire, en même temps qu'on fait le reste.
Sinon pour fabriquer une nouvelle collection, lisez les commentaires guides d'utilisation dans le module MGigogne
 

FCMLE44

XLDnaute Occasionnel
Bonjour

Lorsque je mets mes données réelles, j'obtiens le message suivant

Erreur excéution 1004
Vous avez tapé un nom de feuille ou de graphique non valide

Il crée bien les feuilles mais ne mets pas à jour le récapitulatif

Morceau du code où se trouve l'erreur
VB:
F = F + 1: Set FDest = .Item(F): FDest.Name = NomFeui: End With
Sauriez vous d'où ça peut venir
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Mettez peut être ça pour le calcul de NomFeui :
VB:
      NomFeui = CodSiret.Id & "-" & Right$(String$(5, Chr$(133)) & CStr(NumSiret.Id), 5)
Les "?" sont interdits dans les noms de feuilles.
 

FCMLE44

XLDnaute Occasionnel
Merci

Cela fonctionne. Par contre dans la feuil récap il me crée un onglet -........ car des données à zéro à 0 dans colonne 38 suite formule j'ai 6000 lignes ou se trouvent la formule
 

Dranreb

XLDnaute Barbatruc
Ben voilà donc ce qu'il fallait éviter de faire…
D'ailleurs la macro va l'écraser sur la partie des lignes de données effectivement utilisée.
PlgDon.Columns(38).FormulaR1C1 = "=IF(RC35=0,RC37,ROUND(RC34*(RC35+RC36)/100,0))"
 

FCMLE44

XLDnaute Occasionnel
Pour terminer définitvement cette discussion, j'aurais besoin de créer une feuille Suivi Paiement qui se mette à jour automatiquement

Les données en colonne 2 serait la somme Totale de la Colonne 8 du Code Siret de la feuille DSN
 

Fichiers joints

Discussions similaires


Haut Bas