MACRO pour regrouper des cellules

Bonjour à tous

j'ai un fichier excel avec plusieurs centaine de ligne à traiter par semaine manuellement (risque d'erreur)

Est-il possible avec une macro de pouvoir regrouper le texte de plusieurs cellule en 1 seule

dans ma colonne D ce trouve le code de divers composants et en colonne E les N° de lots à sortir pour la production

est -il possible de regrouper automatiquement les N° de lots dans une seule case (voir cellule K) le + n'est pas une obligation suffit qu'il soit séparé

Par avance Merci

Ced

Bonjour,

Souhaites tu passer absolument par VBA?,

Je pense que d'autres solutions sont possibles,

Cordialement,

Bonjour

Non je suis preneur de tout

Merci

Ced

Bonjour,

Ci joint une solution avec la création d'un tableau CODE_COMPOSANTS, l'incorporation d'un code macro qui intègre la fonction VLOOKUPLIST (la caractéristique de la fonction recherchev est qu'elle ne fait pas apparaitre que la première valeur trouvée, alors que la fonction Vlookuplist permet de retourner toutes les valeurs trouvées).

Tu trouveras un TCD à la droite que tu devras actualisé lorsque tu rempliras le tableau CODE_COMPOSANTS,

Cordialement,

Bonjour BICE45, Salut massari59264,

J'ai également planché sur une solution en macro :

Sub EcrireListeProd()

Dim Lig As Long, Ntbl As Integer, Table() As String, CodeCompo As String, Ncompt As Long

With ActiveSheet
    For Lig = 2 To .Range("A" & .Rows.Count).End(xlUp).Row 'Parcourir les lignes
        If Not IsEmpty(.Cells(Lig, 1)) Then 'Si cellule A non vide
            CodeCompo = .Cells(Lig, 1) 'On retient le Code composant
            ReDim Table(1)
            Table = Split(Replace(.Cells(Lig, 2), " ", ""), "+") 'On sépare le contenu en colonne B en fonction du "+"
            For Ntbl = 0 To UBound(Table) 'On regarde chaque élément séparé
                Ncompt = Sheets(2).Range("A" & .Rows.Count).End(xlUp).Row + 1 'On incrémente la ligne où écrire en feuille 2
                If IsNumeric(Table(Ntbl)) Then 'Si l'élément est un nombre
                    Sheets(2).Cells(Ncompt, 1) = CodeCompo 'On reporte le code composant
                    Sheets(2).Cells(Ncompt, 2) = CInt(Table(Ntbl)) 'On reporte l'élément sans retouche
                Else
                    If Table(Ntbl) Like "KIT*" Then 'Si il commence par "KIT"
                        Sheets(2).Cells(Ncompt, 1) = CodeCompo
                        Sheets(2).Cells(Ncompt, 2) = "KIT" & Application.Rept("0", 8 - Len(Table(Ntbl))) & Right(Table(Ntbl), Len(Table(Ntbl)) - 3) 'On ajoute après "KIT" autant de 0 que nécessaire pour atteindre 8 caractères
                    Else
                        Sheets(2).Cells(Ncompt, 1) = CodeCompo
                        Sheets(2).Cells(Ncompt, 2) = Application.Rept("0", 8 - Len(Table(Ntbl))) & Table(Ntbl) 'On ajoute au début autant de 0 que nécessaire pour atteindre 8 caractères
                    End If
                End If
            Next Ntbl
        End If
    Next Lig
End With

End Sub

Ici avec ton fichier :

Bonjour,

Une autre solution 100% VBA qu'il faut adapté au fichier final.

Bonjour

Merci pour ton travail

La première façon me convient parfaitement

Merci encore

Cordialement

Ced

Les autres solutions apportées sont toutes aussi efficaces ,

Cordialement,

Celui avec macro ne me prend pas tout est-ce normal?

Ced

BICE45 a écrit :

Celui avec macro ne me prend pas tout est-ce normal?

Ced

La plage des valeurs prises en compte est fixe dans ce code.

PS : je viens de voir que mon code est hors sujet, je fais l'inverse de ta demande...

De la manière dont je l'ai construite oui, c'est pour ça que je précise à adapter.

C'est comme la cible, je dépose en M2 mais je ne sais pas si tu le souhaites vraiment là

J'ai fais la modification dans ce fichier joint

Ok pour la macro j'ai changer une valeur et ça me prend bien tout

Merci encore pour tout

Un conseil prends plutôt le deuxième fichier que j'ai mis en pièce jointe. J'ai modifié la plage pour prendre l'ensemble de ta liste, c'est plus fiable et efficace que d'avoir mis 2000 lignes en plage fixe.

Une autre proposition (dans le sujet cette fois !) :

Attention Pedro22, si tu relance plusieurs fois, tu fais une concaténation du résultat précédent avec le nouveau.

freegide a écrit :

Attention Pedro22, si tu relance plusieurs fois, tu fais une concaténation du résultat précédent avec le nouveau.

C'est vrai, merci du commentaire. Voilà donc une autre version pour éviter ça :

Freegide par contre ca me prend pas les lots 0

Y'a pas de quoi, c'est normal

BICE45 en effet comme je n'avais pas ce cas la dans ton premier fichier, je n'ai pas pris ça en compte.

Voilà qui est corrigé. Désolé je n'ai pas le temps de faire un code plus propre.

Merci a vous

Une dernière question si j'ai des lots en rouge y a t'il moyen de les mettre en dernier dans la liste regroupé ?

Merci