A voir également:
- [vba] tableau croisé dynamique
- Tableau croisé dynamique - Guide
- Tableau ascii - Guide
- Tableau word - Guide
- Les données fournies dans le fichier à télécharger peuvent être synthétisées par le tableau récapitulatif suivant. dans le fichier, générez ce tableau automatiquement (tableau croisé dynamique ou table de pilote) à partir des 4 premières colonnes. cinq valeurs manquent dans le tableau suivant. retrouvez-les dans votre tableau puis reportez-les, arrondies à l’entier le plus proche, dans la zone de réponse. - Forum Excel
- Recherchev dans tableau croisé dynamique - Forum Excel
2 réponses
Voici une sub que j'utilise pour créer des TCD. Peut-être pourrez-vous vous en inspirer.
J'en ai fait une version un peu améliorée mais je ne la trouve pas en ce moment.
J'en ai fait une version un peu améliorée mais je ne la trouve pas en ce moment.
Sub TCD() Application.ScreenUpdating = False 'la feuille contenant le bouton doit être celle contenant la base de données que l'on veut utiliser Dim Feuille As String Feuille = ActiveSheet.Name Sheets(Feuille).Activate 'dimension de la plage contenant les données Dim DataR As Long Dim DataC As Integer Dim Source As String Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select DataR = Selection.CurrentRegion.Rows.Count DataC = Selection.CurrentRegion.Columns.Count Source = "bd!R1C1:R" & CStr(DataR) & "C" & CStr(DataC) Dim Champs As Variant Dim Nom As String Dim Col As Integer Dim Ran As Integer Dim Dispo As Long Dim c As Integer Dim FWS As Worksheet 'MÉNAGE: crée ou réinitialise les feuilles nécessaires Add = 1 For i = 1 To Sheets.Count If Sheets(i).Name = "TCD" Then Add = 0 Next i If Add = 0 Then Sheets("TCD").Activate Range("A1").Select Cells.Select Selection.Delete shift:=xlUp Else Set FWS = Sheets.Add With FWS .Move after:=Sheets(Sheets.Count) .Name = "TCD" End With End If '''''''''''''''''''''''''''''''''''''' 'routine qui crée les TCD Champs = Array("*", "TYPE_SERVI", "LIGNE", _ "**", "DIRECTION", "TRACE", "PERIODE", "POSITION", "LIEU", _ "***", "CLA_PONC", _ "****", "OCC_PONC", _ "*****") 'destination Sheets("TCD").Activate Range("A3").Select Nom = "TCD: Ponctualité par position" ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _ Source).CreatePivotTable TableDestination:=Selection, TableName:=Nom ActiveSheet.PivotTables(Nom).SmallGrid = False c = 0 Do While Champs(c) <> "*****" 'DEBUG 'MsgBox (Champs(c) & " - " & Dispo) 'les champs sont disposés selon le symboles qui les précède Select Case Champs(c) Case "*" Dispo = xlPageField Case "**" Dispo = xlRowField Case "***" Dispo = xlColumnField Case "****" Dispo = xlDataField Case Else ActiveSheet.PivotTables(Nom).PivotFields(Champs(c)).Orientation = Dispo End Select c = c + 1 Loop ActiveSheet.PivotTables(Nom).PivotFields("TYPE_SERVI"). _ CurrentPage = "SE" ActiveSheet.PivotTables(Nom).PivotFields("PERIODE").PivotItems("MA"). _ Position = 1 'masque les sommes non désirées Dim Colonne As String Colonne = "A" For i = 1 To 4 j = 6 Do While Left(CStr(Range(Colonne & CStr(j)).Value), 5) <> "Somme" j = j + 1 Loop Range(Colonne & CStr(j)).Delete Colonne = IncrementC(Colonne, 1) Next i 'mise en page Sheets("TCD").Activate Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select End Sub