Formule complexe ou VBA

Bonjour,

Je récupère une nomenclature d'assemblage exporté depuis Solidworks dans un fichier Excel.

Dans cette nomenclature je souhaiterais à partir de la colonne B (repère de l'assemblage) et suivant la colonne D obtenir le résultat afficher en F soit par formule si possible ou sinon par VBA (Avec possibilité d'ajouter une ou 2 colonnes supplémentaire pour obtenir le bon résultat).

Pour la formule le repère 0200 est saisie via Solidworks dans l'assemblage principale et les niveau d'assemblage sont distribué par Solidworks.

Assemblage 0 = assemblage principale, niveau 1 secondaire, niveau 2 tertiaire...

Le but est d'étendre chaque cellule non vide de la colonne B de la cellule en dessous de son niveau jusqu'à la prochaine cellule du même niveau moins une cellule.(ou jusqu'à la dernière cellule si pas de niveau identique)

Exemple pour le B2=0200 et D2=1 donc en de F2 à F129 (car D130=1 comme D2)

Par contre si on crois un sous repère comme le 0350 avec un niveau 2, 3 ou plus, le sous niveau écrasera le niveau inférieure.

Exemple: B130=0300 et D130=1 donc on copie la valeur 0300 en F130 et on étend cette valeur jusqu'à la fin car plus de niveau 1 en D après la ligne 130.

Par contre comme la cellule B229 n'est pas vide B229=0350 et D229=2 on étend donc la valeur 0350 de F229 à F281 car D282=2

Ci joint le fichier Excel d'exemple, la colonne A et C n'apporte rien pour cet exemple.

Toute proposition sera bienvenu car je sèche un peu sur la manière la plus simple (formule) d'obtenir le résultat voulu.

J'espère avoir été suffisamment clair et concis pour mon exemple, merci.

17test-rep-auto2.xlsx (21.73 Ko)

Bonjour

Si j'ai bien compris, en F2 à étirer en dessous

=SI(B2<>"";B2;F1)

Remettre la colonne en format standard, sinon le formule ne fonctionne pas

Merci @78chris, c'est ma formule de départ mais elle ne fonctionne que jusqu'à la ligne 281 en ligne 282 la valeur doit repasser à 0300, ce qui n'est pas le cas et complexifie fortement la formule. En gros le repère 0350 est un sous repère du 0300 et dès que ce sous repère est terminé le repère père (0300) doit reprendre.

Exemple ici avec la formule à droite (en colonne G) et le résultat souhaité à gauche (en colonne F)

image

Je suis finalement parti sur une solution VBA n'ayant pas réussi à faire ce que je souhaitait de manière simple en formule.

La solution actuelle est ujne peu lente (traite les ligne une par une) La voici:

Sub PropagerReperes()
Application.ScreenUpdating = False
Sheets("RepAuto").Activate
'On vide la table "Tab_RepNiveau"
With Sheets("RepAuto").ListObjects("Tab_RepNiveau")
'       Vérification de l'existance de données
        If Not .DataBodyRange Is Nothing Then
'           Si la table contient des données, supprimer
            .DataBodyRange.Rows.Delete
        End If
End With

Sheets("Nomenclature").Range("G6:G" & Sheets("Nomenclature").Cells(Rows.Count, 2).End(xlUp).Row).Copy
Sheets("RepAuto").Range("E2").PasteSpecial xlPasteValues
Sheets("Nomenclature").Range("T6:T" & Sheets("Nomenclature").Cells(Rows.Count, 2).End(xlUp).Row).Copy
Sheets("RepAuto").Range("F2").PasteSpecial xlPasteValues

Dim DernLigne As Long
    With Worksheets("RepAuto")

        'On récupère la dernière ligne de la colonne Niveau
        DernLigne = Range("E" & Rows.Count).End(xlUp).Row
        'on réinitialise les cellules de sauvegarde
        Cells(1, 10).ClearContents
        Range("K1:K30").ClearContents
        Range("K1:K30").NumberFormat = "@" 'Format de texte

        Dim Ligne As Range
        For Each Ligne In Range("E2:E" & DernLigne)
            Cells(Ligne.Row, 7).NumberFormat = "@" 'Format de texte
            'Debug.Print "ligne: " & Ligne.Row 'Affiche la ligne en cours de traitement
            Cells(Ligne.Row, 6).Value = CInt(Cells(Ligne.Row, 6))

            'Si Le niveau et repère sauvegardé est vide
            If Cells(1, 10).Value = "" Then
                If Cells(Ligne.Row, 5).Value <> "" Then
                    Cells(1, 10).Value = Cells(Ligne.Row, 6).Value
                    Cells(1, 11).Value = Cells(Ligne.Row, 5).Value
                    Cells(Ligne.Row, 7).Value = Cells(Ligne.Row, 5).Value
                End If

            'Sinon niveau et repère sauvegardé non vide
            Else
                        Dim Ligne As Range

                'Si le repère est non vide
                If Cells(Ligne.Row, 5).Value <> "" Then
                    'On ecrit la valeur dans la nouvelle colonne repère
                    Cells(Ligne.Row, 7).Value = Cells(Ligne.Row, 5).Value
                    'on sauvegarde la valeur du repère dans la case de niveau corespondante
                    Cells(Cells(Ligne.Row, 6), 11).NumberFormat = "@" 'Format de texte
                    Cells(Cells(Ligne.Row, 6), 11).Value = Cells(Ligne.Row, 5).Value
                    'on sauvegarde le niveau dans la case corespondante
                    Cells(1, 10).Value = Cells(Ligne.Row, 6).Value

                'Sinon la case repère est vide
                Else
                    'Si le niveau sauvegardé est > que le niveau de la ligne
                    If Cells(Ligne.Row, 6) > Cells(1, 10) Then
                       'Debug.Print Cells(Ligne.Row, 6) & ">" & Cells(1, 10)
                       Cells(Ligne.Row, 7).Value = Cells(Cells(1, 10), 11)
                    'le niveau est =
                    ElseIf Cells(Ligne.Row, 6) = Cells(1, 10) Then
                        Debug.Print Cells(Ligne.Row, 6) & "=" & Cells(1, 10)
                        If Cells(1, 10).Value > 1 Then
                            Cells(1, 10).Value = Cells(1, 10) - 1
                        End If
                        Cells(Ligne.Row, 7).Value = Cells(Cells(1, 10), 11)
                    End If
                End If
            End If
        Next
    End With

'On colle dans la feuille nomenclature les repères corrigés
Sheets("RepAuto").Range("G2:G" & DernLigne).Copy
Sheets("Nomenclature").Range("G6").PasteSpecial xlPasteValues ':G" & Sheets("Nomenclature").Cells(Rows.Count, 2).End(xlUp).Row)

'On vide la table "Tab_RepNiveau"
With Sheets("RepAuto").ListObjects("Tab_RepNiveau")
'       Vérification de l'existance de données
        If Not .DataBodyRange Is Nothing Then
'           Si la table contient des données, supprimer
            .DataBodyRange.Rows.Delete
        End If
End With

Application.ScreenUpdating = True

End Sub
Rechercher des sujets similaires à "formule complexe vba"