Automatiser_calcul_excel_en_VBA

Le 15/01/2025 à 09:21

j'ai un fichier excel A:K(poste,soc,centre,date,site,of,cad,cad_kg,num_suiv,article,description_article,equi,equip,qty_prod,qty_prod_kg,Qty_reje,QTY_reje_kg,temps ouverture...

PosteSOCCentreOFsARTICLEDES_ARTICLEQTY_PRODQTY_PROD_KGQTY_REJEQTY_REJE_KGTPS_OUV

). j'ai calculé 3 clés:

Sub CalculerCleHassia()

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("Feuil1")

' 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:A" & lastRow)

' Créer une nouvelle feuille pour le tableau croisé

On Error Resume Next

Set wsPivot = ThisWorkbook.Sheets("Cle_HASSIA")

If wsPivot Is Nothing Then

Set wsPivot = ThisWorkbook.Sheets.Add

wsPivot.Name = "Cle_HASSIA"

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 = "GIAS5" ' Filtrer par Centre

.PivotFields("POSTE").CurrentPage = "HASSIA" ' 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 = 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é_hassia"

For Each row In ptRange.Rows

volumeCol = 5

If IsNumeric(row.Value) Then

row.Offset(0, 1).Value = Round((row.Value / totalVolume) * 100, 2)

End If

Next row

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

End Sub

Sub CalculerCleManuel()

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("Feuil1")

' 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:K" & lastRow)

' Créer une nouvelle feuille pour le tableau croisé

On Error Resume Next

Set wsPivot = ThisWorkbook.Sheets("Cle_MANUEL")

If wsPivot Is Nothing Then

Set wsPivot = ThisWorkbook.Sheets.Add

wsPivot.Name = "Cle_MANUEL"

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")

With pt

' Ajouter les champs pour filtrer

.PivotFields("SOC").Orientation = xlPageField

.PivotFields("CENTRE").Orientation = xlPageField

.PivotFields("POSTE").Orientation = xlPageField

' Définir les filtres pour SOC et CENTRE

.PivotFields("SOC").CurrentPage = "GIAS IND"

.PivotFields("CENTRE").CurrentPage = "GIAS5"

' Gérer le filtrage des postes

Dim item As PivotItem

Dim visiblePostes As Variant

Dim poste As Variant

' Liste des postes à afficher

visiblePostes = Array("MANUEL", "MOMELAN")

' Désactiver les mises à jour automatiques

.ManualUpdate = True

' Parcourir les postes et activer/désactiver selon la liste

For Each item In .PivotFields("POSTE").PivotItems

item.Visible = False ' Désactiver par défaut

For Each poste In visiblePostes

If item.Name = poste Then

item.Visible = True ' Activer les postes souhaités

Exit For

End If

Next poste

Next item

' Réactiver les mises à jour automatiques

.ManualUpdate = False

' 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 = 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 = Round((row.Value / totalVolume) * 100, 2)

End If

Next row

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

End Sub

Sub CalculerCle_tamtas()

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("Feuil1")

' 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:K" & lastRow)

' Créer une nouvelle feuille pour le tableau croisé

On Error Resume Next

Set wsPivot = ThisWorkbook.Sheets("Cle_Tamtas")

If wsPivot Is Nothing Then

Set wsPivot = ThisWorkbook.Sheets.Add

wsPivot.Name = "Cle_Tamtas"

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")

With pt

' Ajouter les champs pour filtrer

.PivotFields("SOC").Orientation = xlPageField

.PivotFields("CENTRE").Orientation = xlPageField

.PivotFields("POSTE").Orientation = xlPageField

' Définir les filtres pour SOC et CENTRE

.PivotFields("SOC").CurrentPage = "GIAS IND"

.PivotFields("CENTRE").CurrentPage = "GIAS5"

.PivotFields("POSTE").CurrentPage = "TAMTAS"

' 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 = 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é_tamtas"

For Each row In ptRange.Rows

volumeCol = 5

If IsNumeric(row.Value) Then

row.Offset(0, 1).Value = Round((row.Value / totalVolume) * 100, 2)

End If

Next row

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

End Sub

j'ai un autre fichier A:I(AXE1,AXE2,AXE3,Concatener ,Clé ,Atelier ,MCSG,MGDI,MIND)

qui contient montant de chaque clé, je veux calculer somme des montants des 3 clés en multipliant %chaque clé * montant de chaque clé puis les sommer et les diviser par quantite totale comment le faire en vba

j'ai creer une table qui affiche le montant de chaque clé ,ci-joint le fichier contenant les 2 feuilles: 1er fichier pour le calcul des clés, comment faire ensuite pour calculer cout industriel de chaque article qui =cle_tamtas * MIND(cle=TAMTAS) + cleManuel * MIND(cle=MANUEL) + cleHassia * mind(cle=HASSIA) / quantite totale

31ere-fichier.zip (465.24 Ko)
22eme-fichier.xlsx (11.65 Ko)
Le 15/01/2025 à 09:45

Bonjour tout d'abord,

Merci de bien vouloir lire ou relire La charte et notamment le point 2 dans le paragraphe "Autres règles à respecter"

Pour vos codes vous disposez d'une icone </> sur laquelle il vous suffit de cliquer pour y placer votre code. Au final c'est nettement plus lisible. J'ai corrigé votre post pour que vous voyiez.

Dans votre profil, vous mentionnez trois versions excel, quelle est la bonne ?
Pour la trouver sous windows : ---> menu Fichier > Compte (en bas) + Clic sur le point d'interrogation puis sur la page suivante au-dessus vous trouvez votre version

Crdlt

Le 15/01/2025 à 09:45

Bonjour,

Pour nous fournir un code il faut utiliser :

A+

Oups Dan, on se bouscule, bien le bonjour

Le 15/01/2025 à 15:08

Rechercher des sujets similaires à "automatiser calcul vba"