vba - calcul via Excel sur cellules disjointes

[haleakala]

[résolu] vba - calcul via Excel sur cellules disjointes

Bonjour,

J'essaie de faire une opération peut-être un peu complexe via vba, qui se décompose en plusieurs parties:
-rechercher via une boucle for les cellules dans une colonne remplissant une certaine condition, et ajouter toutes ces cellules dans un objet range via la fonction Union
-calculer la médiane et la moyenne de l'objet range via Excel (donc via Application.WorksheetFunction.Average)

Voici le code:

    Dim rgConcernedCells(0 To 3, 0 To 23) As Range 'variable accumulant les cellules répondant au critère donné (24 différents critères)
    Dim rgProv As Range
    Dim rgCellProv As Range
    Dim sinDelayAverage(0 To 3, 0 To 5), sinDelayMedian(0 To 3, 0 To 5) As Single


    For i = iRowFirstAction To iProvLengh + iRowFirstAction - 1
        dtActionDate(0) = owActions.Cells(i, iColumnInitialDueDate)
                 
        iProvYear = Year(dtActionDate(0))
        iProvMonth = Month(dtActionDate(0))
        iProvArrayItem = (iProvYear - (iLastDateYear - 1)) * 11 + iProvMonth
        
        For j = 0 To 3
            Set rgCellProv = owActions.Cells(i,iColumCalculDelayClosedActions_ActionSheet)
            If dtFirstDate < dtActionDate(0) And dtActionDate(0) < dtLastDate _
                And rgCellProv <> "" Then
                If rgConcernedCells(j, iProvArrayItem) Is Nothing Then
                    Set rgConcernedCells(j, iProvArrayItem) = rgCellProv
                Else
                    Set rgConcernedCells(j, iProvArrayItem) = Union(rgConcernedCells(j, iProvArrayItem), rgCellProv)
                End If
            End If
        Next j
        
    Next i
        
               
    For j = 0 To 3
        For i = 0 To 5
            rgProv = rgConcernedCells(j, iFirstDateMonth + i)
            sinDelayAverage(j, i) = Application.WorksheetFunction.Average(owActions.rgProv)
            sinDelayMedian(j, i) = Application.WorksheetFunction.Median(owActions.rgProv)
        Next i
    Next j

Malheureusement, je n'arrive pas à aller bien loin avec ce code.
La fonction union semble marcher, mais je ne sais pas si la fonction Application.WorksheetFunction.Median peut s'appliquer à un objet range de cellules discontinues.


L'objectif est bien sûr de calculer la moyenne et la médiane uniquement de certaines cellules répondant à un critère spécifique, et donc je suis conscient que d'autres méthodes existent, cependant celle-ci me semblait assez joli, et donc si qq a une idée pour m'aider à la faire fonctionner, je suis preneur!

Merci!

Haleakala

 

[JYLL]

Re : vba - calcul via Excel sur cellules disjointes

Bonjour Haleakala et le forum,

Avec ce genre de formule, tu peux peut être parvenir à ce que tu souhaites:

Sub Test()
MsgBox "La somme est : " & Application.Sum(Range("A1:A5", "b8:b10")), vbInformation, "Résultat"
End Sub

Tu mets des données de a1 à a5 et B8 à B10 et tu lances la macro tu auras une boîte de dialogue qui te donnera le total. Tu peux ajouter autant de zones que tu veux

@+

 

[Hervé]

Re : vba - calcul via Excel sur cellules disjointes

bonjour

j'ai pas tout compris à ton code, surtout qu'il ne me semble pas complet.

on peut tout a fait appliquer une fonction à des cellules non adjacentes (heureusement d'ailleurs)

ce code fait la moyenne des cellules non vides de la plage A1:A10, c'est pour te donner une idée de code :

Public Sub toto()
Dim plage As Range
Dim c As Range

For Each c In Range("a1:a10")
    If c <> "" Then
        If plage Is Nothing Then
            Set plage = c
        Else
            Set plage = Union(c, plage)
        End If
    End If
Next c

MsgBox Application.Average(plage)
        
End Sub

salut

 

[haleakala]

Re : vba - calcul via Excel sur cellules disjointes

Merci pour les réponses.

Hervé: oui le code n'est pas complet, car la routine fait plus de cent lignes, et j'ai donc supprimé ce qui ne me semblait pas important au problème actuel.

Il me semble avoir mis les éléments essentiels que tu as décris dans ton bout de code très instructif.
Je reprends une partie de mon code avec qq explications supplémentaires
Cf plus bas les explications

'on vérifie si la cellule parcourue (rgCellProv) vérifie les critères            
If dtFirstDate < dtActionDate(0) And dtActionDate(0) < dtLastDate _
                And rgCellProv <> "" Then

'la cellule parcourue remplie les critères, on l'ajoute dans un élément d'un tableau d'objets range via la fonction union
                If rgConcernedCells(j, iProvArrayItem) Is Nothing Then
                    Set rgConcernedCells(j, iProvArrayItem) = rgCellProv
                Else
                    Set rgConcernedCells(j, iProvArrayItem) = Union(rgConcernedCells(j, iProvArrayItem), rgCellProv)
                End If
end if

'maintenant on fait les calculs sur certains éléments du tableau d'objet range (donc rgConcernedCells()).
    For j = 0 To 3
        For i = 0 To 5
            rgProv = rgConcernedCells(j, iFirstDateMonth + i)
            sinDelayAverage(j, i) = Application.WorksheetFunction.Average(owActions.rgProv)
            sinDelayMedian(j, i) = Application.WorksheetFunction.Median(owActions.rgProv)
        Next i
    Next j

Et le problème vient à la fin. Je n'arrive pas à comprendre pourquoi, car la logique me semble la même que celle du code d'Hervé, sauf que je fonctionne avec un tableau d'objets range et pas un seul objet.

Si qqun a une idée...

 

[Hervé]

Re : vba - calcul via Excel sur cellules disjointes

re

pas facile de voir sans fichier

pourrais-tu nous en fournit un, en placant ce que tu as, et ce que tu veux.

je pense que tu as confondu dans ton code variable objet et variable tableau.

ce code : Dim rgConcernedCells(0 To 3, 0 To 23) As Range

me semble faux dans la mesure ou tu déclares ta variables objet (as range) mais en lui pécisant une dimension.

je te donne un autre code qui utilise une variable tableau, mais merci de nous fournir un fichier exemple.

Public Sub titi()
Dim c As Range
Dim tablo()
Dim n As Byte

For Each c In Range("a1:a10")
    If c <> "" Then
        n = n + 1
        ReDim Preserve tablo(1 To n)
        tablo(n) = c
    End If
Next c

MsgBox Application.Average(tablo)
MsgBox Application.Median(tablo)
End Sub

salut

 

[haleakala]

Re : vba - calcul via Excel sur cellules disjointes

En fait je crois avoir trouvé le problème en tatouillant un peu: l'objet range indiquait deux fois une référence à la feuille, du genre

dim iProv as integer
dim rgProv as range
dim wsFeuille as Worksheet
set wsFeuille = activeworksheet
rgProv=wsFeuille.cells(1,1)
iProv=Application.WorksheetFunction.Max(wsFeuille.rgProv)

Comme j'ai fait pas mal de modif depuis que j'ai envoyé la question, je n'ai pas trouvé exactement la source pour la redonner sur le forum, mais maintenant c'est bon...

Merci encore pour les conseils précieux!

 

[Hervé]

Re : vba - calcul via Excel sur cellules disjointes

re

tant mieux si tu as trouvé, c'est le principale.

par contre pour ma culture personnelle, ca marche cette syntaxe ?

Dim rgConcernedCells(0 To 3, 0 To 23) As Range


salut

 

[haleakala]

Re : vba - calcul via Excel sur cellules disjointes

Salut,

par contre pour ma culture personnelle, ca marche cette syntaxe ?

Dim rgConcernedCells(0 To 3, 0 To 23) As Range

Chez moi sous Excel 2003, ça marche parfaitement. Et c'est bien pratique!!!!
C'est une bonne question: je ne te cache pas que je me suis même pas posé la question de savoir si ça marche ou pas avant de l'utiliser... Coup de chance, c'est passé!

Haleakala