Problème de remplissage d'une colonne conditionné à d'autres valeurs

Bonjour,

Je suis nouvelle sur ce forum et en quelques sortes débutante avec Excel VBA.

J’ai créé une macro qui ne fonctionne pas comme je le souhaiterais.

Mon fichier de base est une liste de composants de 3 colonnes :

  • Hierarchy = donne la relation enfant/parent de chaque ligne, est constitué de la même logique que pour un sommaire avec plusieurs chapitres et sous-chapitres.
  • Level = lié au niveau hiérarchique, 1 = parent le plus haut, 5 = enfant le plus bas.
  • Total Unit Weight = poids en kg de chaque ligne.

Dans la macro je souhaite créer une nouvelle colonne « Tempo » qui donne la valeur 1 ou 0 aux cellules de cette colonne selon :

  • Règle 1 : Si Total Unit Weight est différent de zéro, alors Tempo est à 1
  • Règle 2 : Si Total Unit Weight est égal à zéro alors :
    • Si l’un de ses parents à un Total Unit Weight différent de zéro ou si tous ses enfants directs (dont avec un Level ayant une valeur de +1) ont une valeur 1 dans la colonne Tempo, alors la valeur Tempo est égale à 1.
    • Sinon la valeur Tempo est égale à 0.

Le remplissage des lignes se fait par valeur Level décroissant, on remplit d’abord les enfants les plus bas pour remonter ensuite au parent le plus haut (essentiel pour pouvoir appliquer la première ligne de la règle 2).

Voici ce que j’ai écrit mais ça ne fonctionne pas comme je le souhaite.

La boucle hasNonZeroParent m’a l’air de fonctionner mais pas la boucle allChildrenFilled.

J’espère avoir été claire dans la présentation du problème. Je joins le fichier Excel et le code Macro ci-dessous.

Dans le fichier excel, j’ai ajouté une colonne « Ce que devrait afficher la macro » affichant le résultat que devrait me sortir la macro.

Merci à vous.

Fichier Excel :
Fichier_forum_aide.xlsm (22,0 Ko)

Code :
Sub TempoColumn()
Dim lastRow As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim currentLevel As Long
Dim hierarchy As String
Dim parentHierarchy As String
Dim totalUnitWeight As Double
Dim parentWeight As Double
Dim childWeight As Double
Dim maxLevel As Long
Dim levels As Range
Dim allChildrenFilled As Boolean
Dim hasNonZeroParent As Boolean
Dim hierarchyColumn As Long
Dim weightColumn As Long
Dim levelColumn As Long

’ Trouver la dernière colonne utilisée dans la première ligne
lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column

’ Initialiser les variables
levelColumn = 0
hierarchyColumn = 0
weightColumn = 0

’ Trouver les colonnes level, weight et hierarchy
For k = 1 To lastColumn
If Cells(1, k).Value = « Level » Then
levelColumn = k
ElseIf Cells(1, k).Value = « Hierarchy » Then
hierarchyColumn = k
ElseIf Cells(1, k).Value = « Total Unit Weight » Then
weightColumn = k
End If
Next k

lastRow = Cells(Rows.Count, levelColumn).End(xlUp).Row

’ Initialiser maxVal avec la première valeur de la colonne Level
maxLevel = Cells(2, levelColumn).Value

’ Parcourir toutes les lignes de la colonne Level pour trouver la valeur maximale
For m = 3 To lastRow
If Cells(m, levelColumn).Value > maxLevel Then
maxLevel = Cells(m, levelColumn).Value
End If
Next m

’ Ajout d’une colonne « Tempo »
Columns(weightColumn + 1).Select
Selection.Insert
Cells(1, weightColumn + 1).Value = « Tempo »
Columns(weightColumn + 1).NumberFormat = « 0 »

’ Loop du Level le plus haut au plus bas
For currentLevel = maxLevel To 1 Step -1
For i = 2 To lastRow
’ Process rows with the current level
If Cells(i, 2).Value = currentLevel Then
’ Get the hierarchy and weight from the current row
hierarchy = Cells(i, 1).Value
totalUnitWeight = Cells(i, 3).Value

’ Règle 1 : Si Total Unit Weight est différent de zéro, alors Tempo est à 1
If totalUnitWeight <> 0 Then
Cells(i, weightColumn + 1).Value = 1
Else
’ Règle 2 : vérifie parents et enfants
hasNonZeroParent = False
parentHierarchy = hierarchy

’ Vérif si l’un de ses parents à un Total Unit Weight différent de zéro
Do While InStrRev(parentHierarchy, « . ») > 0
parentHierarchy = Left(parentHierarchy, InStrRev(parentHierarchy, « . ») - 1)

For j = 2 To lastRow
If Cells(j, 1).Value = parentHierarchy Then
If Cells(j, weightColumn).Value <> 0 Then
hasNonZeroParent = True
Exit Do
End If
End If
Next j

If hasNonZeroParent Then Exit Do
Loop

’ Vérif si tous ses enfants directs (dont avec un Level ayant une valeur de +1) ont une valeur 1
allChildrenFilled = True
For m = 2 To lastRow
If Left(Cells(m, 1).Value, Len(hierarchy) + 1) = hierarchy & « . » And Cells(m, levelColumn).Value = currentLevel + 1 Then
If Cells(m, weightColumn + 1).Value <> 1 Then
allChildrenFilled = False
Exit For
End If
End If
Next m

If hasNonZeroParent Or allChildrenFilled Then
Cells(i, weightColumn + 1).Value = 1
Else
Cells(i, weightColumn + 1).Value = 0
End If
End If
End If
Next i
Next currentLevel

MsgBox « Macro terminée. »
End Sub

Sub CathyLD()
     Dim aA, A1, aOut() As Integer
     With Sheets("bookmark_editor_Jul 03 2024 17_").Range("A1").CurrentRegion
          aA = .Offset(1).Resize(.Rows.Count - 1, 3).Value     'matrice avec 3 colonnes
          A1 = .Offset(1).Resize(, 1).Value  'matrice avec uniquement le hierarchy
          ReDim aOut(1 To UBound(aA), 1 To 1)     'préparer une matrice pour les résultats
          For i = 1 To UBound(aA)            'boucler
               'Debug.Print i, aA(i, 3)
               If aA(i, 3) > 0 Then aOut(i, 1) = 1     'contient un poids
               j = InStrRev(aA(i, 1), ".")   'position dernier point
               If j > 0 Then
                    s = Left(aA(i, 1), j - 1)     'parent
                    r = Application.Match(s, A1, 0)     'position du parent
                    If aOut(r, 1) = 1 Then
                         aOut(i, 1) = 1      'parent=1 ---> enfant=1
                    Else
                         If aOut(i, 1) = 1 Then aOut(r, 1) = 1     'parent était 0, mais enfant=1, parent=1
                    End If
               End If
          Next
          .Offset(1, 5).Resize(UBound(aOut), 1).Value = aOut     'coller dan colonne F
     End With

End Sub

Fichier_forum_aide.xlsm (28,1 Ko)
Et le « 1 » reste à 0 ???

Bonjour, merci de votre réponse.
J’ai fait des tests avec votre proposition, cela fonctionne, il y a juste le cas « si parent à 0 mais TOUS les enfants sont à 1, alors parent = 1 » qui ne va pas :

                Else
                     If aOut(i, 1) = 1 Then aOut(r, 1) = 1     'parent était 0, mais enfant=1, parent=1
                End If

J’ai essayé d’adapter votre code mais je ne m’en sors pas (désolée j’ai un niveau pas très élevé). Votre code prend comme condition que 1 enfant doit être à 1 et je souhaiterais que la condition soit si tous les enfants sont à 1. Comment puis-je le modifier ?

avec un 2eme boucle en reverse
Fichier_forum_aide.xlsm (29,6 Ko)