Macro : dupliquer des lignes articles et ajoute les codes en fonction des département

[roidurif]

Bonjour,

Je souhaite créer une macro qui duplique les lignes articles et ajoute les codes correspondant aux départements indiquer dans la table Département.

je vous joins un exemple de résultat à obtenir avec la table de correspondance et des explications.

Je vous remercie de votre aide.

 

[Excel-lent]

Re : Macro : dupliquer des lignes articles et ajoute les codes en fonction des départ

Bonjour RoiDuRif,

Tu as des bases en VBA? Car sinon c'est l'occasion révé pour t'y mettre 😉

Et de nôtre côté nous ferrons le maximum pour t'épauler dans cette aventure, te guider, te conseiller.

Première étape :
Onglet "Table DPT", ne pas laisser de cases vide dans la colonne A : répéter à CHAQUE fois le numéro de département associé au code situé juste à droite.

Bref :
* écrire en [A2] -> 10
* écrire en [A5] -> 11
* écrire en [A7], [A8] et [A9] -> 12
* ...

Ainsi ton code sera plus facile à concevoir

Deuxième étape :
Apprendre à utiliser l'enregistreur de macro.
-> tu lance l'enregistreur
-> tu copie la ligne 2
-> tu colle la ligne 2 -> 1 fois
-> tu copie la ligne 3
-> tu colle la ligne 3 -> 1 fois
-> tu arrête l'enregistreur de macro

Troisième étape :
-> analyser la macro ainsi obtenu. Voir les différences entre les deux moitiés de code. Cela te permettra ainsi de voir qu'elle partie du code fait quoi.
-> demander des explications pour les parties que tu ne comprend pas
-> demander à ce qu'une personne t'enlève les parties inutiles (avec le temps, tu serras capable de le faire seul)

Quatrième étape :
-> commencer à travailler le chapitre "boucles", pour que ta macro traite toutes les lignes les unes après les autres. Toutes les copier UNE fois

Cinquième étape :
-> tu pourras compliquer ta macro en te penchans sur la partie : comment dire à excel le nombre de fois qu'il faut copier la ligne ...

L'idéal est de bien procéder par étape et ne pas en bruler certaines. Au risque de se retrouver noyé ou démoralisé par l'immensité de la tache.

Je te laisse faire les 3 premières étapes, puis tu envoie le fichier ainsi obtenu, et nous t'aiderons à mieux comprendre ton code ainsi obtenu.

Bon courage
A bientôt

 

[jp14]

Re : Macro : dupliquer des lignes articles et ajoute les codes en fonction des départ

Bonjour

Ci joint une procédure qui répond à la question.

' déclaration
Option Explicit
Option Base 0
Dim Tablo(1 To 96) As String
Dim Dl1 As Long ' dernière ligne


Sub travdem()
Dim Cellule As Range
Dim Nomfeuille1 As String
Dim Col As String
Dim Data1() As String
Dim Data2() As String
Dim I As Long, J As Long
'parametre
Nomfeuille1 = "Grille de départ"
Col = "A"
travdem2
With Sheets(Nomfeuille1)

For Each Cellule In .Range(Col & "2:" & Col & .Range(Col & .Rows.Count).End(xlUp).Row)
Data1 = Split(Trim(Cellule.Offset(0, 5)))
    For I = LBound(Data1) To UBound(Data1)
        If IsNumeric(CByte(Data1(I))) Then
            Data2 = Split(Tablo(CByte(Data1(I))))
            For J = LBound(Data2) To UBound(Data2)
                Dl1 = Sheets("Feuil1").Range("A" & .Rows.Count).End(xlUp).Row + 1 ' dernière ligne
                .Rows(Cellule.Row).Copy _
                     Destination:=Sheets("Feuil1").Rows(Dl1)
                 Sheets("Feuil1").Range("G" & Dl1) = Data2(J)
             Next J
        End If
    Next I
Next Cellule

End With
End Sub


'creation tableau avec code
Sub travdem2()
Dim Cellule As Range
Dim Nomfeuille1 As String
Dim Col As String
Dim Data1 As String
Dim Numero As Byte

Dim I As Long, J As Long
'parametre
Nomfeuille1 = "Table DPT"
Col = "A"
With Sheets(Nomfeuille1)
Dl1 = .Range("B" & .Rows.Count).End(xlUp).Row ' dernière ligne
For I = 2 To Dl1
    If .Range(Col & I) <> "" Then
    If .Range(Col & I) = "AR" Then
        Numero = 96
    Else
        Numero = CByte(.Range(Col & I))
    End If
    If I >= Dl1 Then
    Tablo(Numero) = .Range("b" & I)
    Else
        Do
            For Each Cellule In .Range(Col & I + 1 & ":" & Col & Dl1)
                Data1 = Cellule
                If Cellule.Value <> "" Then
                    J = Cellule.Row
                    Exit Do
                End If
            Next Cellule
        Loop
    
        Data1 = ""
        For Each Cellule In .Range("b" & I & ":b" & J - 1)
            If Cellule.Value <> "" Then Data1 = Data1 & Cellule.Value & " "
        Next Cellule
        
        Tablo(Numero) = Trim(Data1)
        I = J - 1
    End If

End If
Next I


End With
End Sub

Dans un premier temps création d'une table qui contient les informations de la Table avec comme numéro d'indice le département (AR est transformé en 96)

La macro utilisant la fonction "SPLIT" il est impératif d'avoir un seul espace entre les différents numéros des départements.

Le résultat se trouve dans une feuille "Feuil1".

A tester

JP

 

[Robert]

Re : Macro : dupliquer des lignes articles et ajoute les codes en fonction des départ

Bonjour le fil, bonjour le forum,

Une autre proposition puisque j'y ai planché dessus...
Remarque : J'ai rajouté le département 37 dans la Table DPT avec un code (vide). Tu corrigeras...
Le code :

Sub Macro2()
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim x As Long 'déclare la variable x (incrément)
Dim ne As Byte 'déclare la variable ne (Nombre d'Espaces)
Dim y As Integer 'déclare la variable y (incrément)
Dim r As Range 'déclare la variable r (Recherche)
Dim li As Byte 'déclare la varialbe li (nombre de LIgnes)
Dim z As Byte 'déclare la variable z (incrément)

Application.ScreenUpdating = False 'masque les changements à l'écran
With Sheets("Grille de départ") 'prend en compte l'onglet "Grille de départ" (à adapter si tu changes)
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne de la colonne A (1)
    For x = dl To 2 Step -1 'boucle 1 : inversée de la dernière ligne dl à la ligne 2
        .Cells(x, 6).Value = Replace(.Cells(x, 6).Value, "  ", " ") 'dans la cellule de la colonne F, remplace deux espaces par un seul espace (entre 50 et 53 il y en avait deux dans ton exemple)
        ne = UBound(Split(.Cells(x, 6), " ", -1)) 'définit le nombre d'espaces de la cellule en colonne F
        For y = ne To 0 Step -1 'boucle 2 : inversée sur le nombre d'espace ne à 0
            .Cells(x, 6).Font.Bold = False 'supprime le gras de la cellule de la colonne F
            .Cells(x, 6).Font.ColorIndex = 0 'couleur automatique dans la cellule de la colonne F
           With Cells(x, 6).Characters(Start:=3 * (y + 1) - 2, Length:=2).Font 'prend en compte les deux caractères correspondant au département
                .ColorIndex = 3 'couleur rouge
                .FontStyle = "Gras" 'police gras
            End With 'fin de la prise en compte de...
            Set r = Sheets("Table DPT").Columns(1).Find(Split(.Cells(x, 6), " ", -1)(y)) 'définit la recherche
            If r.Row = 322 Then li = 1 'si r se trouve en ligne 322, définit le nombre de lignes li = 1
            If Not r Is Nothing And r <> " " Then li = Sheets("Table DPT").Range(r, r.End(xlDown)).Cells.Count - 1 'récupère le nombre de ligne du département
            For z = 1 To li 'boucle 3 de 1 au nombre de lignes du département li
                .Rows(x).Copy 'copie la ligne de la boucle 1
                .Rows(x + 1).Insert Shift:=xlDown 'l'insère une ligen en dessous
                .Cells(x + 1, 7).Value = r.Offset(li - z, 1).Value 'place le code (en commenánt par le dernier)
            Next z 'prochaine ligne de la boucle 3
        Next y 'prochain espace de la boucle 2
    .Rows(x).Delete 'supprime la ligne de la boucle 1
    .Range(.Cells(x, 1), .Cells(x, 7)).Interior.ColorIndex = 48 'colore de gris la ligne de la boucle 1
    Next x 'prochaine ligne de la boucle 1
End With 'fin de la prise en compte de l'onglet "Grille de départ" (à adapter si tu changes)
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub

Le fichier :

 

[jp14]

Re : Macro : dupliquer des lignes articles et ajoute les codes en fonction des départ

Bonsoir
Bonsoir Robert

Le code suivant permet de supprimer les espaces inutiles.
La fonction "Trim" dans une macro n'est pas identique à la fonction dans une feuille Excel (cf "Aide")

Data1 = Split(Application.WorksheetFunction.Trim(Cellule.Offset(0, 5)))

A tester

JP

 

[Robert]

Re : Macro : dupliquer des lignes articles et ajoute les codes en fonction des départ

Bonsoir le fil, bonsoir le forum,

En effet JP je n'y avait pas pensé. J'aurais donc pu écrire :

.Cells(x, 6).Value = Application.WorksheetFunction.Trim(Cells(x, 6))

à la place de :

.Cells(x, 6).Value = Replace(.Cells(x, 6).Value, "  ", " ")