VBA- Cacul d'une Médiane

VBA- Cacul d'une Médiane - VB/VBA/VBS - Programmation

Marsh Posté le 05-08-2015 à 18:12:09    

Bonjour Forum,
 
Je me suis confronté à un problèe de calcul du salaire médian. Au fait, je fais des TCDs et dans celui-ci, je veux sortir 4 colonnes (Moyenne, Min, Max et Median) sur le calcul de la variable salaire en fonction de mes deux autres variables (catégorie et sexe)
 
Mon code marche bien si je supprime la partie de calcul de la médiane. je ne sais pas pourquoi la fonction " .Function=xlMedian" ne marche pas....
 
Je vous met ci-joint un aperçu de ma sortie du TCD que je souhaite avoir sauf que si je supprime la partie du calcul de la médiane cela marche super bien. (ne tenez pas compte de la mise en forme, elle a été faite manuellement...)
 
Je vous remercie d'avance.
 
Mon CODE :  
 
 
Option Explicit
Dim wsData As Worksheet, wsPT As Worksheet
Dim rngData As Range
Dim ptCache As PivotCache
Dim pt As PivotTable
 
 
Sub TCDautomatique3_Bouton2_Cliquer()
 
 Application.DisplayAlerts = False
     
    Application.ScreenUpdating = False
 
    Set wsData = Worksheets("Données3" )
    Set rngData = wsData.Cells(1).CurrentRegion
    Set wsPT = Worksheets("TCD automatique3" )
     
    'Suppression de tous les TCD existants dans la feuille
     
   For Each pt In wsPT.PivotTables
        pt.TableRange2.Clear
    Next pt
     
 With wsPT
    Set ptCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, rngData, 4)
     
     
     Set pt = ptCache.CreatePivotTable(wsPT.Range("B12" ), "TCD_1", , 4)
   
    With Sheets("TCD automatique3" ).Activate
        Range("B10" ) = "Les salaires annuels bruts en kilo euros par type de formation "
        Range("B10" ).Font.Size = 18
        Range("B10" ).Font.Italic = True
        Range("B10" ).Font.Name = "Arial"
    End With
       
   
     With pt
        .ManualUpdate = True
       
       
       'Ajout d'une Ligne Régime de formation
        With .PivotFields("regime_6m" )
            .Orientation = xlRowField
            .Position = 1
        End With
         
       'Ajout d'une Ligne spécialité
        With .PivotFields("specialite_6m" )
            .Orientation = xlRowField
            .Position = 2
        End With
             
     ' Calcul du saliare moyen
     
     With pt.PivotFields("emploi_salaire_6m" )
        .Orientation = xlDataField
        .Function = xlAverage
        .Position = 1
        .NumberFormat = "0.00"
        .Name = "Moyenne"
    End With
 
    'Calcul du salaire Min
     
    With pt.PivotFields("emploi_salaire_6m" )
        .Orientation = xlDataField
        .Function = xlMin
        .Position = 2
        .NumberFormat = "0.00"
        .Name = "Min"
    End With
     
   ' Calcul du salaire Max
     
    With pt.PivotFields("emploi_salaire_6m" )
        .Orientation = xlDataField
        .Function = xlMax
        .Position = 3
        .NumberFormat = "0.00"
        .Name = "Max"
    End With
     
    ' Calcul du salaire Median
     
    With pt.PivotFields("emploi_salaire_6m" )
        .Orientation = xlDataField
        .WorksheetFunction.Median ("emploi_salaire_6m" )
        .Position = 4
        .NumberFormat = "0.00"
        .Name = "Mediane"
    End With
   
   
     
   .ManualUpdate = False
  End With
     
End With
 
    Set pt = Nothing
    Set ptCache = Nothing
    Set rngData = Nothing
    Set wsPT = Nothing: Set wsData = Nothing
 
 
End Sub

Reply

Marsh Posté le 05-08-2015 à 18:12:09   

Reply

Marsh Posté le 05-08-2015 à 20:57:44    

Bonjour,
 
.Function = WorksheetFunction.Median("emploi_salaire_6m" )
 
?
 
+ merci d'utiliser la balise cpp pour mettre du code, une ligne ça passe, plusieurs ça devient indispensable.
 
 
Cordialement, Forum.


---------------
C'est en écrivant n'importe quoi qu'on devient n'importe qui.
Reply

Marsh Posté le 06-08-2015 à 00:55:47    

Bonjour,
 
Merci, j'utiliserai prochainement la balise ccp pour mettre mes codes.
Mais J'ai mis .Function=WorksheetFunction.Median("emploi_salaire_6m" )  dans ma fonction mais çà affiche toujours le message d'erreur "Impossible de lire la proprièté Median dans WorksheetFunction.
 
 

Reply

Marsh Posté le 06-08-2015 à 18:42:05    

Oui, en même temps tu n'utilises pas les bons paramètres dans ta fonction, il faut spécifier la liste des valeurs en paramètre de la fonction median. Du coup je ne pense pas que tu puisses l'utiliser ici.
 
 
PS : tu peux éditer ton message pour rajouter les balises.


---------------
C'est en écrivant n'importe quoi qu'on devient n'importe qui.
Reply

Marsh Posté le 06-08-2015 à 20:42:06    

Bonjour,
 
Ci-dessous mon code (j'ai essayé de mettre les balises...)
 
je veux sortir le TCD avec les 4 colonnes (Moyenne, Min, Max et Median) sur le calcul de la variable salaire en fonction de mes deux autres variables (le règime de la formation et la spécialité) :
 

Code :
  1. Option Explicit
  2.  
  3. Dim wsData As Worksheet, wsPT As Worksheet  
  4. Dim rngData As Range  
  5. Dim ptCache As PivotCache  
  6. Dim pt As PivotTable  
  7.  
  8.  
  9. [cpp] Sub TCDautomatique3_Bouton2_Cliquer()  
  10.  
  11. Application.DisplayAlerts = False  
  12.      
  13.    Application.ScreenUpdating = False  
  14.  
  15.    Set wsData = Worksheets("Données3" )  
  16.    Set rngData = wsData.Cells(1).CurrentRegion  
  17.    Set wsPT = Worksheets("TCD automatique3" )  
  18.      
  19.    'Suppression de tous les TCD existants dans la feuille  
  20.      
  21.   For Each pt In wsPT.PivotTables  
  22.        pt.TableRange2.Clear  
  23.    Next pt  
  24.      
  25. With wsPT  
  26.    Set ptCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, rngData, 4)  
  27.      
  28.      
  29.     Set pt = ptCache.CreatePivotTable(wsPT.Range("B12" ), "TCD_1", , 4)  
  30.    
  31.    With Sheets("TCD automatique3" ).Activate  
  32.        Range("B10" ) = "Les salaires annuels bruts en kilo euros par type de formation "  
  33.        Range("B10" ).Font.Size = 18  
  34.        Range("B10" ).Font.Italic = True  
  35.        Range("B10" ).Font.Name = "Arial"  
  36.    End With  
  37.        
  38.    
  39.     With pt  
  40.        .ManualUpdate = True  
  41.        
  42.        
  43.       'Ajout d'une Ligne Régime de formation  
  44.        With .PivotFields("regime_6m" )  
  45.            .Orientation = xlRowField  
  46.            .Position = 1  
  47.        End With  
  48.          
  49.       'Ajout d'une Ligne spécialité  
  50.        With .PivotFields("specialite_6m" )  
  51.            .Orientation = xlRowField  
  52.            .Position = 2  
  53.        End With  
  54.              
  55.     ' Calcul du saliare moyen  
  56.      
  57.     With pt.PivotFields("emploi_salaire_6m" )  
  58.        .Orientation = xlDataField  
  59.        .Function = xlAverage  
  60.        .Position = 1  
  61.        .NumberFormat = "0.00"  
  62.        .Name = "Moyenne"  
  63.    End With  
  64.  
  65.    'Calcul du salaire Min  
  66.      
  67.    With pt.PivotFields("emploi_salaire_6m" )  
  68.        .Orientation = xlDataField  
  69.        .Function = xlMin  
  70.        .Position = 2  
  71.        .NumberFormat = "0.00"  
  72.        .Name = "Min"  
  73.    End With  
  74.      
  75.   ' Calcul du salaire Max  
  76.      
  77.    With pt.PivotFields("emploi_salaire_6m" )  
  78.        .Orientation = xlDataField  
  79.        .Function = xlMax  
  80.        .Position = 3  
  81.        .NumberFormat = "0.00"  
  82.        .Name = "Max"  
  83.    End With  
  84.      
  85.    ' Calcul du salaire Median  
  86.      
  87.    With pt.PivotFields("emploi_salaire_6m" )  
  88.        .Orientation = xlDataField  
  89.        .WorksheetFunction.Median ("emploi_salaire_6m" )  
  90.        .Position = 4  
  91.        .NumberFormat = "0.00"  
  92.        .Name = "Mediane"  
  93.    End With  
  94.    
  95.    
  96.      
  97.   .ManualUpdate = False  
  98.  End With  
  99.      
  100. End With  
  101.  
  102.    Set pt = Nothing  
  103.    Set ptCache = Nothing  
  104.    Set rngData = Nothing  
  105.    Set wsPT = Nothing: Set wsData = Nothing  
  106.  
  107.  
  108. End Sub


Message édité par gilou le 06-08-2015 à 23:07:59
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed