XL 2016 VBA Calcul Ecart-type

james7734

XLDnaute Junior
Bonjour à tous,

Je possède un fichier VBA avec un code permettant de transposer dans la "Feuil1" les noms de colonnes et de calculer la moyenne pour chaque colonne contenu dans la feuille "Data". Voilà, j'essaie de rajouter une colonne de donnée dans la feuil1, permettant de calculer l'"écart-type" pour chaque Nom. Je ne sais pas trop comment m'y prendre pour l'ajouter au code existant. En plus simple, je veux juste une 3è colonne dans la feuil1 avec les écart-types.

Je ne sais pas si j'ai été assez clair,

Merci énormément,
 

Pièces jointes

  • test (2).xlsm
    61.3 KB · Affichages: 6
Solution
Pour ceux qui ne jurent que par VBA voyez le fichier .xlsm joint et ces 2 macros :
VB:
Private Sub Worksheet_Activate()
Dim ncol%, i%
With Sheets("Data").[A1].CurrentRegion
    ncol = .Columns.Count - 1
    If ncol Then 'si au moins 2 colonnes
        ReDim resu(1 To ncol, 1 To 3)
        For i = 1 To ncol
            resu(i, 1) = .Cells(1, i + 1)
            resu(i, 2) = Application.Average(.Columns(i + 1)) 'moyenne
            resu(i, 3) = Application.StDev(.Columns(i + 1)) 'écart-type
        Next
    End If
End With
'---restitution---
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution, à adapter
    If ncol Then .Resize(ncol...

job75

XLDnaute Barbatruc
Pour ceux qui ne jurent que par VBA voyez le fichier .xlsm joint et ces 2 macros :
VB:
Private Sub Worksheet_Activate()
Dim ncol%, i%
With Sheets("Data").[A1].CurrentRegion
    ncol = .Columns.Count - 1
    If ncol Then 'si au moins 2 colonnes
        ReDim resu(1 To ncol, 1 To 3)
        For i = 1 To ncol
            resu(i, 1) = .Cells(1, i + 1)
            resu(i, 2) = Application.Average(.Columns(i + 1)) 'moyenne
            resu(i, 3) = Application.StDev(.Columns(i + 1)) 'écart-type
        Next
    End If
End With
'---restitution---
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de restitution, à adapter
    If ncol Then .Resize(ncol, 3) = resu
    .Offset(ncol).Resize(Rows.Count - ncol - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Activate 'lance la macro
End Sub
Les macros sont placées dans le code de la 2ème feuille.

La 1ère se déclenche quand on active la feuille, la 2ème quand on modifie une cellule quelconque : le résultat ne peut pas être modifié.

Bonsoir sylvanu.
 

Pièces jointes

  • test VBA(1).xlsm
    64.9 KB · Affichages: 4

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour James,Job,
Dans ma PJ il y a inversion des colonnes moyenne écartype.
Ci joint la PJ corrigée. J'en ai profité pour l'optimiser :
VB:
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
With Sheets("Data")
    .Activate
    For N = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column
        Sheets("Feuil1").Cells(N, 1) = .Cells(1, N)
        Sheets("Feuil1").Cells(N, 2) = Application.Average(.Columns(N))
        Sheets("Feuil1").Cells(N, 3) = Application.StDev(.Columns(N))
    Next N
End With
Application.EnableEvents = False
Sheets("Feuil1").Activate
Application.EnableEvents = True
End Sub
 

Pièces jointes

  • test (V3).xlsm
    66 KB · Affichages: 10

Discussions similaires

Réponses
2
Affichages
321

Membres actuellement en ligne

Statistiques des forums

Discussions
312 206
Messages
2 086 219
Membres
103 158
dernier inscrit
laufin