AIDE - MACRO somme si

Bonjour à tous,

Je rencontre un problème avec mon fichier, je voudrais exécuter une macro, mais je ne sais pas par ou commencer.

Pour vous expliquer mon fichier qui est en pièce jointe :

Dans la colonne A, j'ai une origine de cable qui porte un nom et dans la colonne B j'ai une extrémité de cable qui porte un nom et dans la colonne M, j'ai une valeur.

Donc on peut avoir un cable en extrémité et dans une autre configuration en origine. C'est comme une toile d’araignée.

Pour vous donner idée je voudrais calculer toute la toile d'araignée en faisant le cumul de la colonne M.

Par exemple :

A B 3

B C 4

D E 1

C F 2

E G 8

A H 3

H I 2

Si je veux calculer mon montant pour l'origine A, j'obtiens un chiffre de 14. Pour l'origine D, j'obtiens aussi 9. Pour l'origine C, j'obtiens 2....

En premier, j'ai fait une somme si (colonne N) qui me permet de calculer le premier lien.

Avez vous une idée pour faire ce genre de calcul ? Faut-il passer par une macro ?

Merci d'avance pour vos réponse

13bloquage.xlsx (11.92 Ko)

Bonjour,

Par exemple :

A B 3

B C 4

D E 1

C F 2

E G 8

A H 3

H I 2

pour l'origine A, j'obtiens un chiffre de 14.

Pour l'origine D, j'obtiens aussi 9.

Pour l'origine C, j'obtiens 2....

Désolé, mais je n'ai pas compris comment tu trouvais 14 à partir du tableau !

Bonjour,

Excuse moi si ce n'est pas clair.

Pour l'origine A :

J'ai A->B = 3 + B-->C = 4 + C-->F = 2 et A-->H = 3 + H-->I = 2

Soit 3+4+2+3+2 = 14

La c'est un fichier simple mais je vais avoir plus de 1000 lignes ou je dois faire ce calcul.

Merci

Sujet très intéressant !! je vais m'y mettre cet am.

Sub calcul()
Set r = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
    For Each cel In r
        Set X = cel
        longueur = 0
        Do
            Set Y = X.Offset(0, 1)
            longueur = longueur + X.Offset(0, 2).Value
            Set X = r.Find(Y.Value)
        Loop While Not X Is Nothing
        cel.Offset(0, 3).Value = longueur
    Next
Sheets("Feuil2").Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
End Sub

attention qu'il n'y ait pas de boucles !

8cable.xlsm (22.77 Ko)

Faut-il aussi prévoir le cas où :

A > B

B > C

B > D

?

Merci beaucoup, je viens de faire le test et cela fonctionne.

Oui il faut prévoir ce cas là. Il peut arriver.

Est ce que tu penses que c'est faisable en Macro ?

Oui il faut prévoir ce cas là. Il peut arriver.

Est ce que tu penses que c'est faisable en Macro ?

Bon, ben va falloir alors agiter les neurones ! cela risque de me prendre un moment avant de trouver une solution simple avec des fonctions récursives.

Dans l'immédiat, teste quand même si tu as des ramifications multiples avec le fichier joint ... cela sera indiqué dans la dernière colonne des données d'entrée.

5cable.xlsm (23.39 Ko)

Bonjour,

version qui prend en compte les ramifications multiples ... comme cité plus haut, exemple :

A > B

B > C

B > D

Sub nomenclature()
Dim compteur()
Dim cel As Range
Dim dico As Object
Set dico = CreateObject("Scripting.Dictionary")

Sheets("DATA").Select
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    Set cel = Columns("B").Find(Cells(i, 1))
    If cel Is Nothing Then
        dico(Cells(i, 1).Value) = ""
    End If
Next

niveaux = 0
ligne = 2
With Sheets("NOMENCLATURE")
    On Error Resume Next
    .ListObjects(1).DataBodyRange.Delete
    On Error GoTo 0
    .Range("F1").CurrentRegion.Offset(1, 0).ClearContents
    For Each cle In dico.keys
        .Cells(ligne, 1) = 1
        .Cells(ligne, 2) = cle
        ligne = ligne + 1
    Next
    ligne = 2
    Do
        For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
            If Cells(i, 1) = .Cells(ligne, 2) Then
                .Rows(ligne + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                .Cells(ligne + 1, 2) = Cells(i, 2)
                .Cells(ligne + 1, 3) = Cells(i, 3)
                .Cells(ligne + 1, 1) = .Cells(ligne, 1) + 1
                If .Cells(ligne, 1) + 1 > niveaux Then niveaux = .Cells(ligne, 1) + 1
            End If
        Next
        ligne = ligne + 1
    Loop While .Cells(ligne, 1) <> ""
End With

ReDim compteur(0 To niveaux + 1)
For j = 0 To niveaux + 1
    compteur(j) = 0
Next

Sheets("NOMENCLATURE").Select
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    Cells(i, Cells(i, 1) + 5) = Cells(i, 2)
    Cells(i, 4) = compteur(Cells(i, 1))
    For j = 0 To Cells(i, 1)
        compteur(j) = compteur(j) + Cells(i, 3)
    Next
    For j = Cells(i, 1) To niveaux + 1
        compteur(j) = 0
    Next
Next

Sheets("CALCUL").Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh

End Sub
9cable-v2.xlsm (29.65 Ko)

Bonjour,

Une autre piste avec une Sub récursive, le résultat en colonnes D et E :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Dico As Object
    Dim Cle As Variant
    Dim Longueur As Long
    Dim I As Long

    With Worksheets("DATA")

        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))

        Set Dico = CreateObject("Scripting.Dictionary")

        For Each Cel In Plage

            Dico(Cel.Value) = Dico(Cel.Value) + Cel.Offset(, 2).Value
            Totaliser Plage, Longueur, Cel.Offset(, 1).Value
            Dico(Cel.Value) = Dico(Cel.Value) + Longueur
            Longueur = 0

        Next Cel

        For Each Cle In Dico.Keys

            I = I + 1
            .Cells(I, 5).Value = Cle
            .Cells(I, 6).Value = Dico(Cle)

        Next Cle

    End With
End Sub

Sub Totaliser(Plage As Range, Longueur As Long, Extremite As String)

    Dim Cel As Range

    For Each Cel In Plage

        If Cel.Value = Extremite Then

            Longueur = Longueur + Cel.Offset(, 2).Value
            Totaliser Plage, Longueur, Cel.Offset(, 1).Value

        End If

    Next Cel

End Sub

Oups, pas D et E mais E et F

Je suis parti de la feuille DATA de Steelson pour l'exemple !

Voici le code commenté pour plus de compréhension :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Dico As Object
    Dim Cle As Variant
    Dim Longueur As Long
    Dim I As Long

    With Worksheets("DATA")

        'défini la plage sur la colonne A de la feuille "DATA" à partir de A2
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))

        'crée le dictionnaire qui va servir aux noeuds de départ
        Set Dico = CreateObject("Scripting.Dictionary")

        'parcours la plage et totalise les longueurs. Le dictionnaire évite les doublons
        For Each Cel In Plage

            'totalise pour la même origine comme par exemple, les deux A
            Dico(Cel.Value) = Dico(Cel.Value) + Cel.Offset(, 2).Value

            'appel de la Sub récursive un peu comme on fait avec un TreeView
            Totaliser Plage, Longueur, Cel.Offset(, 1).Value

            'au retour, additionne à la valeur déjà présente dans le dico
            Dico(Cel.Value) = Dico(Cel.Value) + Longueur

            'remet à 0 pour le calcul de la longueur suivante
            Longueur = 0

        Next Cel

        'inscrit les résultats en colonnes E et F sur la même feuille (DATA)
        For Each Cle In Dico.Keys

            I = I + 1
            .Cells(I, 5).Value = Cle
            .Cells(I, 6).Value = Dico(Cle)

        Next Cle

    End With
End Sub

Sub Totaliser(Plage As Range, Longueur As Long, Extremite As String)

    Dim Cel As Range

    'parcours la plage à la recherche de l'extrémité correspondante
    For Each Cel In Plage

        'si trouvée, additionne puis recherche la nouvelle extrémité
        'comme on le ferait dans l'explorateur pour la recherche des sous-dossiers
        If Cel.Value = Extremite Then

            Longueur = Longueur + Cel.Offset(, 2).Value
            Totaliser Plage, Longueur, Cel.Offset(, 1).Value

        End If

    Next Cel

    'si l'extrémité n'existe pas, fin de procédure et retour de la longueur qui est passée en référence (par défaut dans VBA)
    'comme pour l'explorateur quand on arrive au dernier sous-dossier

End Sub

Excellent ! la fonction récursive que je cherchais !

Après réflexion, je pense que je totalise plusieurs fois les montants donc je crois qu'il faut sortir de la boucle dans la fonction récursive une fois l'extrémité trouvée :

Sub Totaliser(Plage As Range, Longueur As Long, Extremite As String)

    Dim Cel As Range

    For Each Cel In Plage

        If Cel.Value = Extremite Then

            Longueur = Longueur + Cel.Offset(, 2).Value
            Totaliser Plage, Longueur, Cel.Offset(, 1).Value
            Exit For '<--- sortir une fois l'extrémité trouvée !

        End If

    Next Cel

End Sub

Si par exemple on suit depuis le premier A on a :

A - B = 3, B - C = 4, C - F = 2, A - H = 3, H - I = 2 soit un total de 14 et non de 33 !

De même pour B :

B - C = 4, C - F = 2, B - D = 4, D - E = 1, E - G = 8 soit un total de 19 et non 25 !

Donc, à voir avec notre ami Lige ce qu'il en pense

Non, je ne pense pas ! je trouve la même chose et j'ai fait le parcours à la main pour vérifier (c'est l'avantage du tracé de la nomenclature).

Si par exemple on suit depuis le premier A on a :

A - B = 3, B - C = 4, C - F = 2, A - H = 3, H - I = 2 soit un total de 14 et non de 33 !

N'oublie pas la branche B-D, D-E, E-H, H-I, et E-G, et enfin B-C, C-F ... soit bien 33.

capture d ecran 79

Donc tu avais bon sans aucun doute et ta fonction est super puissante !

Bonjour,

Bonjour Steelson

Donc tu avais bon sans aucun doute et ta fonction est super puissante !

Merci, donc j'ai eu une mauvaise réflexion, suivre à l'oeil c'est pas évident !

Excellent ! la fonction récursive que je cherchais !

Je te la donne avec plaisir, prends en bien soin

Excellent ! la fonction récursive que je cherchais !

Je te la donne avec plaisir, prends en bien soin

J'en fais régulièrement, j'en ai fait en javascript des tonnes, mais là j'étais bloqué et je ne sais pas pourquoi.

mais là j'étais bloqué et je ne sais pas pourquoi.

Rassures toi, ça m'arrive souvent et pour des choses bien plus simples !

Bonjour,

Je voulais vous remercier car la macro fonctionne parfaitement. Je ne pensais pas qu'on pouvait aller aussi loin.

Impressionnant Bravo

Pour vous expliquer le but du fichier est d'identifier l'impact d'un point de blocage.

Pour vous donner un exemple lorsque j'ai un blocage entre A et B, il faut que j'arrive à savoir quelle longueur cela impact.

Avec votre fichier j'y arrive, je sais qu'il y a une longueur de 33. Cela me permet de prioriser mes actions pour lever ces points de blocages.

Par contre lorsque je lève le blocage entre A et B, cela ne me débloque pas forcément la longueur de 33 (il peut y avoir un blocage plus loin). Pensez vous qu'il est possible d'avoir un tableau dynamique qui me permet de suivre ces points de blocages ? et de savoir lorsque je lève un point de blocage, l'impact derrière ?

J'ai joint votre fichier, en ajoutant des colonnes dans l'onglet DATA avec des types de blocages, lorsque que la valeur est égal à 1 c'est que c'est ok pas de blocage par contre lorsque la valeur est égal à 0, il y a un blocage

Merci

9cable-v2-2.xlsm (30.76 Ko)
Rechercher des sujets similaires à "aide macro somme"