Tableaux, ubound, moyenne sous contraintes

Bonjour!

D'accord c'est noté je regarde ce que je peux faire de mon côté Bonne journée!

Re,

J'ai trouvé un code qui marche!! mais il me donne la bonne moyenne une fois sur deux Je pense que c'est un problème avec l’incrémentation de "k" je vais changer ça...

Et j'ai pour cette remarque:

Car je persiste à penser que tu auras des moyennes dont tu ne sauras plus à quoi elles peuvent correspondre...

Pas eu le temps de regarder...

J'ai toutefois fait rapidement une adaptation de la fin de la macro initiale (j'ai laissée les lignes supprimées en les invalidant comme repère) :

    'b = ip.Keys
    s = ip.Items
    ReDim v(UBound(b) - (UBound(b) < 0), 0)
    For i = 0 To UBound(b)
        'v(i, 0) = b(i)
        v(i, 0) = s(i)(0) / s(i)(1)
    Next
    Set plage = Worksheets("feuil1").Range("A1").End(xlToRight)(2, 1)
    plage.Resize(i - (i = 0)).Value = v
    plage.Offset(-1) = "moy. xxx"

La dernière ligne est ajoutée pour le cas (qui m'avait semblé dans tes intentions) où tu lances le calcul plusieurs fois après modif du tableau, la recherche de la colonne sefaisant sur la ligne 1, il faut qu'une valeur soit mise dans la cellule si on veut conserver chaque résultat, pour ne pas qu'il écrase le précédent. Donc modifier ce qui est à mettre le cas échéant...

Cordialement.

Bonjour MFerrand!

Tout d'abord un grand merci pour le temps consacré à m'aider! J'ai utilisé la méthode que vous m'avez proposée et ça convient parfaitement!! J'ai juste modifié quelques points car il y avait une erreur d'indice...

J'était sur le point de poster une nouvelle question sur la pondération de la moyenne par une autre colonne (que je pensais facile à partir du code pour la moyenne!) et j'ai essayé une dernière tentative qui a fonctionné! (je l'ai mis en PJ). Je crois que je m'améliore!

Je continue mon travail! Bonne journée!!

Rebonjour!

Décidément il y a toujours une surprise! Le code marche bien sur le fichier exemple et lorsque je le copie dans le nouveau classeur il y une erreur d'indice sur cette ligne

v(0) = v(0) + (s(i, 1) * t(i, 1))

! La seul différence c'est que les moyennes sont copiées sur une autre feuille...

Option Explicit
Option Base 0
Sub moy_pentes()

Dim dat1 As Range, dat2 As Range, dat3 As Range, plage As Range
Dim i&, b(), s(), v(), t()
Dim ip As Object

With Worksheets("donnees_totales")
Set ip = CreateObject("scripting.dictionary")
Set dat1 = Worksheets("donnees_totales").Range(.Range("C1"), .Range("C1").End(xlDown))
Set dat2 = Worksheets("donnees_totales").Range(.Range("M1"), .Range("M1").End(xlDown))
Set dat3 = Worksheets("donnees_totales").Range(.Range("K1"), .Range("K1").End(xlDown))
  b = dat1.Value
  s = dat2.Value
  t = dat3.Value
  For i = 2 To UBound(b)
    If Not IsEmpty(b(i, 1)) And Not IsEmpty(s(i, 1)) And IsNumeric(s(i, 1)) Then
      If ip.Exists(b(i, 1)) Then
        v = ip(b(i, 1))
        v(0) = v(0) + (s(i, 1) * t(i, 1)): v(1) = v(1) + t(i, 1)
        ip(b(i, 1)) = v
      Else
        ip.Add b(i, 1), Array((s(i, 1) * t(i, 1)), t(i, 1))

      End If
    End If
  Next
  'b = ip.Keys
       s = ip.Items
        ReDim v(UBound(s) - (UBound(s) < 0), 1 To 1)
        For i = 0 To UBound(s)
            'v(i, 1) = b(i)
           v(i, 1) = s(i)(0) / s(i)(1)
        Next
        Set plage = Worksheets("resultats").Range("A1").End(xlToRight)(2, 2)
        plage.Resize(i - (i = 0)).Value = v
        plage.Offset(-1) = "moy. pondérée"

  End With

End Sub

ça marche quand je mets le code dans un module à part!! Quelque chose posait surement problème dans le code qu'il y avait au-dessus!

Bonne soirée! A+

Est-ce que t est toujours défini et numérique ? Tu ne le testes pas comme les autres....

Re,

Effectivement mais ça ne marchait toujours pas, et en fait c'est à cause de la base! Pour les codes précédents c'est en base 1 et cette dernière partie c'est en base 0! Mais j'avais pourtant fait la modification... donc ce n'est pas possible de changer de base dans un même module?

Je conseille toujours de ne pas utiliser Option Base 1.

C'est un truc à s'emmêler les pinceaux, et il est plus simple lorsque tu veux baser autrement tu le fasses en dimensionnant :

Dim ou ReDim tablo(1 To 2)

Redim tablo (-10 To 0)...

D'accord c'est noté! Merci pour le conseil!

IL y a une nouvelle opération que j'aimerais mettre en place... Je n'ai pas créer un nouveau poste car pour le moment j'ai besoin d'un conseil ou plutôt d'une réponse à deux questions (et après il me faudra sûrement beaucoup de temps pour faire le tour de ce problème! ):

Je pense que la "feuil1" de la PJ montre tout de suite ce que je cherche à faire mais s'il le faut je peux mieux expliquer...)

1-Est-ce que c'est possible (je pense que la réponse est oui mais en fait je ne sais pas!...) Sinon quel est le résultat le plus proche que je pourrais chercher?

2- Dois-je utiliser 1 ou 2 dictionnaires?

Je suis déjà entrain d'essayer mais si c'est possible, une réponse à ces deux questions ça va me motiver!

d'avance!!

Bonjour,

C'est bien sûr possible puisque tu le démontres déjà manuellement !

L'idée de 2 dictionnaires peut s'avérer intéressante : un dont la clé est l'i-pacage où tu totalises les surfaces qui y correspondent (qui sera le dénominateur de ton calcul), l'autre dont la clé concatène i-pacage et type (de façon à avoir une correspondance entre les deux) où tu totalises les surfaces par type.

Tu n'as même pas besoin de passer par des tableaux : pour chaque clé du premier (affectée à la première cellule), tu parcours le second, et à chaque élément rattaché, tu extrais le type, tu calcules le % (quotient des valeurs mise en forme) et tu construis progressivement la chaîne à affecter à ta 2e cellule.

Cordialement.

edit : Quoique ta variable d'affectation peut être un tableau, à construire pas à pas avec Redim Preserve, et tu peux l'affecter par :

= Join(tablo, "-")

Merci pour cette réponse rapide!

D'accord remarque intéressante!

C'est un peu ce à quoi je pensais! Et je pense qu'en suivant ce plan ça va le faire!

Merci encore pour tout!! et bonne soirée!!

Merci encore pour tout!! et bonne soirée!!

Il est 8h20 chez moi...

Lol!Désolé!! J'avais une chance sur deux!! Bonne journée alors!

Bonjour le fil,

Pour ta nouvelle demande, tu peux en effet utiliser un dictionnaire principal associé à un sous-dictionnaire.

Vois ceci :

Option Explicit

Sub test()
Dim a, b(), i As Long, n As Long, w()
Dim x As Double, y As Double, e, v, res As Byte
    ReDim w(1 To 3)
    With Sheets("Feuil1").Range("a1").CurrentRegion
        a = .Value
        ReDim b(1 To UBound(a, 1), 1 To 2)
        b(1, 1) = a(1, 1): b(1, 2) = a(1, 3)
        n = 1
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If Not .exists(a(i, 1)) Then
                    n = n + 1
                    w(1) = n: w(2) = a(i, 2)
                    Set w(3) = _
                    CreateObject("Scripting.Dictionary")
                    w(3).CompareMode = 1
                    w(3)(a(i, 3)) = a(i, 2)
                    .Item(a(i, 1)) = w
                Else
                    w = .Item(a(i, 1))
                    If Not w(3).exists(a(i, 3)) Then
                        w(3)(a(i, 3)) = a(i, 2)
                    Else
                        w(3)(a(i, 3)) = w(3)(a(i, 3)) + a(i, 2)
                    End If
                    w(2) = w(2) + a(i, 2)
                    .Item(a(i, 1)) = w
                End If
            Next
            For Each e In .keys
                n = .Item(e)(1): x = .Item(e)(2)
                'Set w = .Item(e)(3)
                b(n, 1) = e
                For Each v In .Item(e)(3)
                    y = .Item(e)(3)(v)
                    res = CInt(y / x * 100)
                    If Not IsEmpty(b(n, 2)) Then
                        b(n, 2) = b(n, 2) & " - " & v & "(" & res & "%)"
                    Else
                        b(n, 2) = v & "(" & res & "%)"
                    End If
                Next
            Next
        End With
        Application.ScreenUpdating = False
        With .Offset(, .Columns.Count + 1).Resize(n, 2)
            .CurrentRegion.Clear
            .Value = b
            With .CurrentRegion
                With .Rows(1)
                    .Font.Bold = True
                    .BorderAround Weight:=xlThin
                    .Interior.ColorIndex = 36
                End With
                .BorderAround Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .HorizontalAlignment = xlCenter
                .Columns.AutoFit
            End With
        End With
        Application.ScreenUpdating = True
    End With
End Sub

klin89

Bonjour!

Ce code marche comme sur des bits! Bon je n'ai pas encore tout compris bien sur et j'aurai peut-être des questions!? Mais en tout cas merci beaucoup pour ton aide! Je crois que j'étais encore loin d'y arriver