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.
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)
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