XL 2016 VBA Calcul Ecart-type

james7734 · 11 Mai 2020

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,

job75 · 11 Mai 2020

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 · 11 Mai 2020

Bonsoir james7734,

Fichier .xlsx joint sans le VBA qui semait le bazar.

A+

sylvanu · 11 Mai 2020

Bonsoir James,Job,
Un essai en PJ en conservant la macro.

job75 · 11 Mai 2020

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.

sylvanu · 12 Mai 2020

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

XL 2016 VBA Calcul Ecart-type

james7734

XLDnaute Junior

Pièces jointes

job75

job75

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

Discussions similaires