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

[auverland]

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

 

[Jacky67]

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

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

 

[mapomme]

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

 

[job75]

Bonjour auverland, Jacky67, mapomme,

Une autre solution VBA dans le fichier joint :

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.

 

[Jacky67]

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.

Bonjour job75, mapomme
C'est la différence entre un éternel débutant comme moi et un pro comme toi

 

[job75]

Tu n'es pas du tout débutant Jacky et ta macro va très bien, la mienne est seulement plus complète.

 

[auverland]

Merci @job75 @Jacky67 @mapomme vous etes trop fort

tite question il y a une raison particulière pour écrire les deux ligne de façon différente ?

Set calculA = .Columns(6).SpecialCells(xlCellTypeFormulas, 1)
Set calculB = .[G:G].SpecialCells(xlCellTypeFormulas, 1)

 

[job75]

Non c'est un oubli, remplacez .[G:G] par .Columns(7).

 

[auverland]

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]

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 :

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+