Transformer_tableau_dynamique_croise_avec_Code_VBA_Excel

j'ai un fichier excel A:J(

). je veux calculer un clé, par exemple: volume QT1004, on filtrant soc="gias ind", centre="GIAS6",poste="QT1004"

on aura un tableau dynamique croisé article | description_article | volume | clé=volume de chaque article / total volume . comment faire ce calcul en vba

Bonjour et bienvenue,

Vous pouvez faire ce calcul directement dans le TCD :

Faites clic gauche sur le champ de somme > paramètres de champ > montrer les valeurs comme > % du grand total.

je sais mais j'ai plusieurs clés je veux les rendre automatique avec vba si possible.

j'ai essayé avec ce code mais la colonne clé est vide

Sub CalculerCleVolume()
Dim ws As Worksheet
Dim pt As PivotTable
Dim pc As PivotCache
Dim rngSource As Range
Dim wsPivot As Worksheet
Dim lastRow As Long

' Définir la feuille contenant les données source
Set ws = ThisWorkbook.Sheets("Etat de Prod ")

' Déterminer la dernière ligne de données
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row

' Définir la plage des données source
Set rngSource = ws.Range("A1:J" & lastRow)

' Créer une nouvelle feuille pour le tableau croisé
On Error Resume Next
Set wsPivot = ThisWorkbook.Sheets("PivotTable")
If wsPivot Is Nothing Then
Set wsPivot = ThisWorkbook.Sheets.Add
wsPivot.Name = "PivotTable"
Else
wsPivot.Cells.Clear
End If
On Error GoTo 0

' Créer le cache du tableau croisé
Set pc = ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=rngSource)

' Créer le tableau croisé
Set pt = pc.CreatePivotTable( _
TableDestination:=wsPivot.Range("A3"), _
TableName:="CleVolumePivot")

' Ajouter les champs au tableau croisé
With pt
' Ajouter les champs pour filtrer
.PivotFields("SOC").Orientation = xlPageField
.PivotFields("CENTRE").Orientation = xlPageField
.PivotFields("POSTE").Orientation = xlPageField

' Définir les filtres
.PivotFields("SOC").CurrentPage = "GIAS IND" ' Filtrer par SOC
.PivotFields("CENTRE").CurrentPage = "GIAS6" ' Filtrer par Centre
.PivotFields("POSTE").CurrentPage = "QT1004" ' Filtrer par Poste

' Ajouter les champs pour les lignes et les données

.PivotFields("DES_ARTICLE").Orientation = xlRowField
With .PivotFields("QTY_PROD_KG")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
End With
End With

' Ajouter une colonne pour la clé
Dim ptRange As Range
Dim totalVolume As Double
Dim row As Range
Dim volumeCol As Integer
Dim keyCol As Integer

Set ptRange = wsPivot.Range("A3").CurrentRegion
totalVolume = Application.WorksheetFunction.Sum(ptRange.Columns(7))

' Ajouter une colonne pour la clé
keyCol = ptRange.Columns.Count + 1
ptRange.Cells(5, keyCol).Value = "Clé (%)"
For Each row In ptRange.Rows
If row.row >= 5 Then
volumeCol = 5
If IsNumeric(row.Cells(volumeCol).Value) Then
row.Cells(keyCol).Value = row.Cells(volumeCol).Value / totalVolume
End If
End If
Next row

MsgBox "Clé calculée avec succès !", vbInformation
End Sub

Difficile à dire avec simplement le code et peu d'explications… Si vous pouviez joindre le fichier svp.

En attendant, je vois que vous avez utilisé, à la fin, row.Cells(colonne).

Faites attention avec cette instruction, .Cells est assez surprenante, et meme si en théorie votre range n'est qu'une ligne, il se peut qu'en écrivant ceci vous référenciez en fait les lignes en dessous. Il vaut mieux toujours expliciter .Cells(ligne, colonne).

Essayez le code ci-après et dites-moi si vous observez un changement

  ' Ajouter une colonne pour la clé
  keyCol = ptRange.Columns.Count + 1
  ptRange.Cells(5, keyCol).Value = "Clé (%)"
  For Each row In ptRange.Rows
    If row.row >= 5 Then
      volumeCol = 5
      If IsNumeric(row.Cells(1, volumeCol).Value) Then
        row.Cells(1, keyCol).Value = row.Cells(1, volumeCol).Value / totalVolume
      End If
    End If
  Next row

Pour info, dans l'édition de message le bouton </> permet de formater le code correctement.

ci-joint le fichier, j'ai changé la partie code avec la votre mais la colonne clé est encore vide

Re,

Voici un code qui fonctionne sur la partie des clés, en me basant sur le votre :

  ' Ajouter une colonne pour la clé
  Dim ptRange As Range
  Dim totalVolume As Double
  Dim row As Range
  Dim volumeCol As Integer
  Dim keyCol As Integer

  Set ptRange = pt.RowRange.Offset(0, 1)

  With pt.DataBodyRange
    totalVolume = .Cells(.Cells.Count).Value
  End With

  ' Ajouter une colonne pour la clé
  ptRange.Cells(1, ptRange.Columns.Count + 1).Value = "Clé (%)"
  For Each row In ptRange.Rows
      volumeCol = 5
      If IsNumeric(row.Value) Then
        row.Offset(0, 1).Value = row.Value / totalVolume
      End If
  Next row

oui ça marche merci, est ce que je peux le mettre en bouton et l'appeler ?

Bien sûr, remplacez la partie du code correspondante dans votre macro, et vous pouvez ensuite la lier à un bouton. Vous vous occupez très bien de la gestion de feuille existante ou non, donc a-priori je ne vois pas de raison particulière pour que ça plante.

Bonne journée.

PS : dans votre profil, la version d'Excel attendue est : Abonnement 365 / 2021/ 2019 / 2016 ... Pas "VBA".

d'accord merci bien