XL 2016 calculer une moyenne avec des points d'une colonne

auverland

XLDnaute Occasionnel
Bonjour le forum

Je reçois des données en colonne sur lequel il faudrait que je calcul la moyenne sur des point bien spécifique de fonctionnement.

Mes données arrivent sur les colonne A,B,C,D et E sur énormément de lignes.....
Sur les colonnes : Calcul A et Calcul B j'extrais bien mes points de fonctionnement mais je ne vois pas comment calculer la moyenne pour chacun des points.

auriez-vous un script qui puisse réaliser cette opération simplement ?

Merci d'avance pour votre aide
 

Pièces jointes

  • Moyenne par points.xlsx
    29.1 KB · Affichages: 18

Jacky67

XLDnaute Barbatruc
Bonjour le forum

Je reçois des données en colonne sur lequel il faudrait que je calcul la moyenne sur des point bien spécifique de fonctionnement.

Mes données arrivent sur les colonne A,B,C,D et E sur énormément de lignes.....
Sur les colonnes : Calcul A et Calcul B j'extrais bien mes points de fonctionnement mais je ne vois pas comment calculer la moyenne pour chacun des points.

auriez-vous un script qui puisse réaliser cette opération simplement ?

Merci d'avance pour votre aide
Bonjour,
Une proposition par vba
VB:
Sub test()
    Dim x As Double, x1 As Double, fin&, fin1&, debut&, debut1&, c As Range
    debut = 7: debut1 = 7
    Range("l7:m" & Rows.Count).ClearContents
    For Each c In Range("f2:f" & Cells(Rows.Count, "f").End(xlUp).Row)
        If c.Value <> 0 Then x = x + c: fin = fin + 1
        If c.Value <> 0 And c.Offset(1) = 0 Then
            Cells(debut, "L") = x / fin
            x = 0: fin = 0: debut = debut + 1
        End If

        If c.Offset(, 1).Value <> 0 Then x1 = x1 + c.Offset(, 1): fin1 = fin1 + 1
        If c.Offset(, 1).Value <> 0 And c.Offset(1, 1) = 0 Then
            Cells(debut1, "M") = x1 / fin1
            x1 = 0: fin1 = 0: debut1 = debut1 + 1
        End If
    Next
    Columns("L:M").AutoFit
End Sub
 

Pièces jointes

  • Moyenne par points.xlsm
    30.1 KB · Affichages: 8
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @auverland,

Un essai par formules. On utilise deux colonnes auxiliaire H et I qui donne le numéro de chaque bloc des colonnes F (Calcul A) et G (Calcul B) au moyen d'une formule. la formule est à placer en H2 et à recopier vers la droite et vers le bas.
Formule en H2 : =SI(ET(ESTNUM(F2);ESTTEXTE(F1));MAX(H$1:H1)+1;SI(ET(ESTNUM(F2);ESTNUM(F1));H1;""))

On utilise ensuite ces deux colonnes pour faire les calculs des moyennes de chaque bloc. Pour cela mettre la formule suivante en L7 et recopier cette formule vers la droite et vers le bas.
Formule en L7: =SIERREUR(MOYENNE.SI(H:H;LIGNES($1:1);F:F);"")

edit : bonjour @Jacky67 :)
 

Pièces jointes

  • auverland- Moyenne par points- v1.xlsx
    124.7 KB · Affichages: 9

job75

XLDnaute Barbatruc
Bonjour auverland, Jacky67, mapomme,

Une autre solution VBA dans le fichier joint :
VB:
Sub Calcul_moyenne()
Dim calculA As Range, calculB As Range, nA&, nB&, n&, resu(), i&
With Feuil1 'CodeName de la feuille
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    On Error Resume Next 'si aucune SpecialCell
    Set calculA = .Columns(6).SpecialCells(xlCellTypeFormulas, 1)
    Set calculB = .[G:G].SpecialCells(xlCellTypeFormulas, 1)
    On Error GoTo 0
    If Not calculA Is Nothing Then nA = calculA.Areas.Count
    If Not calculB Is Nothing Then nB = calculB.Areas.Count
    n = IIf(nA > nB, nA, nB)
    If n Then
        ReDim resu(1 To n, 1 To 3)
        For i = 1 To n: resu(i, 1) = "Point " & i: Next
        For i = 1 To nA: resu(i, 2) = Application.Average(calculA.Areas(i)): Next
        For i = 1 To nB: resu(i, 3) = Application.Average(calculB.Areas(i)): Next
    End If
    '---restitution---
    With .[K7] '1ère cellule de restitution, à adapter
        If n Then
            .Resize(n, 3) = resu
            .Resize(n, 3).Borders.Weight = xlThin 'bordures
            .Cells(1, 2).Resize(n, 2).Interior.Color = RGB(217, 225, 242) 'bleu
        End If
        .Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1, 3).Delete xlUp 'RAZ en dessous
    End With
End With
End Sub
Edit : j'ai testé en copiant le tableau source sur 59 700 lignes :

- macro de Jacky67 => 1,00 seconde

- macro de job75 => 0,30 seconde, normal car on utilise un tableau VBA pour la restitution.

Bonne journée.
 

Pièces jointes

  • Moyenne par points(1).xlsm
    32.2 KB · Affichages: 10
Dernière édition:

auverland

XLDnaute Occasionnel
Bonjour le Forum


Y a t il une solution pour ne calculer la moyenne que si il y a a minima 5 chiffres ?
car il m'arrive d'avoir des moyennes calculer alors qu'il n'y a que 3 chiffres, ceux-là je voudrait les scraper

If Not calculA Is Nothing Then nA = calculA.Areas.Count

Merci de votre aide et good week-end
 

job75

XLDnaute Barbatruc
Bonsoir auverland, le fil,
Y a t il une solution pour ne calculer la moyenne que si il y a a minima 5 chiffres ?
Vous voulez dire au minimum 5 nombres.

Voyez ce fichier (2) et la macro :
VB:
Sub Calcul_moyenne()
Dim mini, calculA As Range, calculB As Range, nA&, nB&, n&, resu(), i&, n1&, n2&
mini = 5 'nombre minimum pour le calcul de moyenne
With Feuil1 'CodeName de la feuille
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    On Error Resume Next 'si aucune SpecialCell
    Set calculA = .Columns(6).SpecialCells(xlCellTypeFormulas, 1)
    Set calculB = .Columns(7).SpecialCells(xlCellTypeFormulas, 1)
    On Error GoTo 0
    If Not calculA Is Nothing Then nA = calculA.Areas.Count
    If Not calculB Is Nothing Then nB = calculB.Areas.Count
    n = IIf(nA > nB, nA, nB)
    If n Then
        ReDim resu(1 To n, 1 To 3)
        For i = 1 To nA
            If calculA.Areas(i).Count >= mini Then n1 = n1 + 1: resu(n1, 2) = Application.Average(calculA.Areas(i))
        Next
        For i = 1 To nB
            If calculB.Areas(i).Count >= mini Then n2 = n2 + 1: resu(n2, 3) = Application.Average(calculB.Areas(i))
        Next
        n = IIf(n1 > n2, n1, n2)
        For i = 1 To n: resu(i, 1) = "Point " & i: Next
    End If
    '---restitution---
    With .[K7] '1ère cellule de restitution, à adapter
        If n Then
            .Resize(n, 3) = resu
            .Resize(n, 3).Borders.Weight = xlThin 'bordures
            .Cells(1, 2).Resize(n, 2).Interior.Color = RGB(217, 225, 242) 'bleu
        End If
        .Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1, 3).Delete xlUp 'RAZ en dessous
    End With
End With
End Sub
A+
 

Pièces jointes

  • Moyenne par points(2).xlsm
    31.2 KB · Affichages: 2

Discussions similaires