Somme glissante sur une colonne et condition Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Répondre
m
maroon
Membre fidèle
Membre fidèle
Messages : 160
Inscrit le : 2 mai 2016
Version d'Excel : 2013

Message par maroon » 17 janvier 2020, 17:38

Bonjour,

Je poste un deuxième sujet dans la même journée car c'est chaud pour moi :cry:

Je cherche à faire une macro (ou peut-être qu'il existe une fonction excel??) pour calculer le nombre de fois que la somme de trois cellules glissantes sur ma colonne est égale à une certaine valeur. Et il faudrait que je puisse changer le nombre de cellules prises en compte dans la somme de même que la valeur seuil.

Je mets un fichier exemple pour que ça soit plus clair.

Un grand merci à la personne qui pourra m'aider, même une indication car je pourrai peut-être faire la macro avec quelques indices! :)
ExempleI_excel_pratique.xlsx
(11.4 Kio) Téléchargé 84 fois
Avatar du membre
Yvouille
Passionné d'Excel
Passionné d'Excel
Messages : 9'129
Appréciations reçues : 93
Inscrit le : 6 avril 2007
Version d'Excel : 2016

Message par Yvouille » 17 janvier 2020, 18:58

Salut,

Je te propose une solution par macro. A lancer par le bouton en place après avoir modifié tes données en B1 et B2.

Le contrôle en gris ne vaut que pour le premier exemple donné. Il m'a aidé pour vérifier ma macro. mais je l'ai laissé en place.

Amicalement.
Somme_V1.xlsm
(24.33 Kio) Téléchargé 81 fois
1 membre du forum aime ce message.
Yvouille

Valais de Coeur
m
maroon
Membre fidèle
Membre fidèle
Messages : 160
Inscrit le : 2 mai 2016
Version d'Excel : 2013

Message par maroon » 17 janvier 2020, 19:20

Bonjour Yvouille et merci pour votre réponse!

Je la vois au moment ou je dois partir donc je regarde ça dès mon retour!

Merci encore! :mrgreen:
Avatar du membre
curulis57
Passionné d'Excel
Passionné d'Excel
Messages : 3'747
Appréciations reçues : 226
Inscrit le : 4 janvier 2016
Version d'Excel : 2016 FR / 2019 FR

Message par curulis57 » 17 janvier 2020, 20:37

Salut Maroon,
Salut Yvouille,

Sans doute fort semblable à celle d'Yvouille (°v°)°
La macro démarre sur un changement de valeur en [B1:B2] et prend en compte automatiquement le nombre de colonnes de données en feuille 'COEF' pour délivrer le résultat en feuille 'SOMME'.
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim tTab, tCoef, iRow%, dblTot#, dblTemp#
'
If Not Intersect(Target, Range("B1:B2")) Is Nothing Then
    iRow = CInt(Range("B1").Value)
    dblTot = CDbl(Range("B2").Value)
    Range("A4").CurrentRegion.Delete shift:=xlUp
    With Worksheets("COEFF")
        iCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        tTab = .Range("A2").Resize(.Range("A" & Rows.Count).End(xlUp).Row - 1, iCol).Value
        tCoef = .Range("A1").Resize(2, iCol).Value
        For x = 1 To iCol
            tCoef(2, x) = 0
        Next
    End With
    For x = 1 To UBound(tTab, 2)
        For y = 1 To UBound(tTab, 1) - (iRow - 1)
            dblTemp = 0
            For Z = 0 To iRow - 1
                dblTemp = dblTemp + CDbl(tTab(y + Z, x))
            Next
            If dblTemp >= dblTot Then tCoef(2, x) = CInt(tCoef(2, x)) + 1
        Next
    Next
    Range("A4").Resize(iCol, 2).Value = WorksheetFunction.Transpose(tCoef)
    Range("A4").CurrentRegion.Borders.LineStyle = xlContinuous
    Range("A4").Resize(iCol, 1).Interior.ColorIndex = 15
End If
'
End Sub
8-)
A+
Maroon.xlsm
(19.15 Kio) Téléchargé 78 fois
m
maroon
Membre fidèle
Membre fidèle
Messages : 160
Inscrit le : 2 mai 2016
Version d'Excel : 2013

Message par maroon » 18 janvier 2020, 01:36

Rebonjour Yvouille et curulis57 !

Mille merci pour votre aide.

Yvouille j'arrive à faire fonctionner ta macro et ça correspond exactement comme je vouais! Ca va beaucoup m'aider :mrgreen:

Par contre curulis57 je n'arrive pas à activer la macro! Ca fait un moment que je n'ai pas travailler avec des macro donc c'est surement pour ça. Quand j'ouvre une nouvelle macro et que je copie le code ça me dit "end sub" attendu... Je n'ai pas l'habitude avec les événements Worksheet. Si ce n'est pas trop demander est-il possible d'avoir quelques commentaires d'explication dans le code??
Merci à toi pour ton aide!

Et Yvouille encore merci :D
m
maroon
Membre fidèle
Membre fidèle
Messages : 160
Inscrit le : 2 mai 2016
Version d'Excel : 2013

Message par maroon » 18 janvier 2020, 01:42

Resalut Curulis57,

C'est bon ça fonctionne au top! En fait je n'avais jamais utiliser les événements worksheet selectionchange! Du coup je suis toujours preneur de quelques commentaires dans le code pour m'aider à comprendre! :)

Un grand merci à vous deux pour votre aide précieuse! :mrgreen:
Avatar du membre
curulis57
Passionné d'Excel
Passionné d'Excel
Messages : 3'747
Appréciations reçues : 226
Inscrit le : 4 janvier 2016
Version d'Excel : 2016 FR / 2019 FR

Message par curulis57 » 18 janvier 2020, 05:12

Salut Maroon,
Salut Yvouille,

quelques commentaires sur le code, comme demandé.
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim tTab, tCoef, iRow%, dblTot#, dblTemp#
'
If Not Intersect(Target, Range("B1:B2")) Is Nothing Then            'si une donnée change en [B1:B2]
    iRow = CInt(Range("B1").Value)                                  'nbre de lignes "glissées"
    dblTot = CDbl(Range("B2").Value)                                'seuil
    Range("A4").CurrentRegion.Delete shift:=xlUp                    'effacement calcul précédent
    With Worksheets("COEFF")                                        'prise d'info dans 'COEF'
        iCol = .Cells(1, Columns.Count).End(xlToLeft).Column        'nbre de colonnes de données
        tTab = .Range("A2").Resize(.Range("A" & Rows.Count).End(xlUp).Row - 1, iCol).Value      'données mises en tableau
        tCoef = .Range("A1").Resize(2, iCol).Value                  'mise en tableau des en-têtes tableau + 1 ligne pour les sommes recherchées...
        For x = 1 To iCol                                           '...lesquelles sont mises à 0 avant le calcul
            tCoef(2, x) = 0
        Next
    End With
    For x = 1 To UBound(tTab, 2)                                    'on parcourt les colonnes de tTab
        For y = 1 To UBound(tTab, 1) - (iRow - 1)                   'on parcourt les lignes de tTab jusqu'à X lignes avant la fin = iRow
            dblTemp = 0                                             'valeur-tampon mise à 0
            For Z = 0 To iRow - 1                                   'on additionne dans dblTemp le nbre de lignes "glissées"
                dblTemp = dblTemp + CDbl(tTab(y + Z, x))
            Next
            If dblTemp >= dblTot Then tCoef(2, x) = CInt(tCoef(2, x)) + 1       'si dblTemp >= seuil, tCOEF de la colonne + 1
        Next
    Next
    Range("A4").Resize(iCol, 2).Value = WorksheetFunction.Transpose(tCoef)      'le tableau tCOEF étant pris horizontalement dans 'COEF', on transpose le résultat verticalement
    Range("A4").CurrentRegion.Borders.LineStyle = xlContinuous                  'encadrement
    Range("A4").Resize(iCol, 1).Interior.ColorIndex = 15                        'coloration en-têtes
End If
'
End Sub
En parcourant les sujets du forum, je suis tombé sur une demande similaire où tu parlais de 18.000 lignes de données à calculer...
Si c'est pour ce calcul, nul doute que ça va flasher! ;;)

8-)
A+
1 membre du forum aime ce message.
m
maroon
Membre fidèle
Membre fidèle
Messages : 160
Inscrit le : 2 mai 2016
Version d'Excel : 2013

Message par maroon » 18 janvier 2020, 21:37

Salut Curulis57,

Merci pour les commentaires je comprends un peu mieux certaines parties du code :D

Oui effectivement c'est un peu long pour le calcul mais je n'ai pas à le faire souvent donc ça me pose pas de problème!

Merci encore pour toute l'aide apportée!
m
maroon
Membre fidèle
Membre fidèle
Messages : 160
Inscrit le : 2 mai 2016
Version d'Excel : 2013

Message par maroon » 19 janvier 2020, 04:37

Rebonjour Yvouille et Curulis57,
Oui c'est encore moi :|

Je vais peut-être abuser de votre générosité mais je tente quand même le coup parce que je suis un peu dans le rush.

En travaillant sur mes données je me suis rendu compte qu'en plus d'avoir besoin du nombre de fois que la somme glissante répond à la condition il faut aussi que je connaisse le nombre de cellules qui répondent à cette même condition.
Par exemple si la condition est respectée pour A2:A4 , A3:A5 et A8:A10 alors il faudrait que j'obtienne 3 comme avec le code que vous m'avez envoyé mais il faut aussi que j'ai une macro qui me donne 8 comme résultat c'est-à-dire A2,A3,A4,A5,A8,A9,A10.

J'essaye de voir comment adapter les codes que vous m'avez envoyé mais pour le moment j'y arrive pas. Ca me semble "un peu" plus compliquer que ma première demande, surtout le fait qu'on puisse avoir la(les) mêmes cellules dans deux plages différentes et qu'il ne faut pas les compter deux fois.

Faut-il utiliser l'objet "dictionnary" pour ça ? C'est la solution que je suis en train d'essayer pour le moment.

Si cette requête est trop compliquée à mettre en place dites le moi et je vais essayer d'obtenir les résultats autrement... même si je sais pas trop comment pour l'instant :?
Avatar du membre
curulis57
Passionné d'Excel
Passionné d'Excel
Messages : 3'747
Appréciations reçues : 226
Inscrit le : 4 janvier 2016
Version d'Excel : 2016 FR / 2019 FR

Message par curulis57 » 19 janvier 2020, 05:44

Salut Maroon,

je te laisse le soin de vérifier les comptes de cellules mais je pense que c'est bon!
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim tTab, tCoef, iRow%, iIdx%, dblTot#, dblTemp#
'
If Not Intersect(Target, Range("B1:B2")) Is Nothing Then
    iRow = CInt(Range("B1").Value)
    dblTot = CDbl(Range("B2").Value)
    Range("A4").CurrentRegion.Delete shift:=xlUp
    With Worksheets("COEFF")
        iCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        tTab = .Range("A2").Resize(.Range("A" & Rows.Count).End(xlUp).Row - 1, iCol).Value
        Range("A5").Resize(iCol, 1).Value = WorksheetFunction.Transpose(.Range("A1").Resize(1, iCol))
        tCoef = Range("A5").Resize(iCol, 3).Value
    End With
    For x = 1 To UBound(tTab, 2)
        iIdx = 0
        For y = 1 To UBound(tTab, 1) - (iRow - 1)
            dblTemp = 0
            For Z = 0 To iRow - 1
                dblTemp = dblTemp + CDbl(tTab(y + Z, x))
            Next
            If dblTemp >= dblTot Then
                tCoef(x, 2) = CInt(tCoef(x, 2)) + 1
                tCoef(x, 3) = CInt(tCoef(x, 3)) + IIf(iIdx < y, iRow, (y + iRow - 1) - iIdx)
                iIdx = y + iRow - 1
            End If
        Next
    Next
    Range("A5").Resize(iCol, 3).Value = tCoef
    Range("A4").Resize(1, 3).Value = Array("", "Blocs", "Cel")
    Range("A4").CurrentRegion.Borders.LineStyle = xlContinuous
    Range("A5").Resize(iCol, 1).Interior.ColorIndex = 15
    Range("B4").Resize(1, 2).Interior.ColorIndex = 45
End If
'
End Sub
8-)
A+
Maroon.xlsm
(23.97 Kio) Téléchargé 75 fois
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message