Fusionner plusieurs lignes en une seule + additionner valeur colonne

Bonjour à tous,

C'est la première fois que je participe à ce forum en demandant de l'aide (car c'est la première fois que je dois pousser Excel ou VBA dans ses retranchements (Attention je n'ai jamais manipuler de VBA de ma vie ^^).

J'ai un fichier avec 5 colonne et 4 lignes , le but est donc de n'avoir qu'une seule ligne et qu'il fasse la somme automatiquement.

Je reste à votre dispo pour vous apportez plus d'infos si besoin.

Merci à vous si vous pouvez m'aider et m'accompagner dans cette aide

Alex

Bonjour,

Un tableau croisé dynamique ne ferait pas l'affaire ? Tu peux faire des sommes par libellé de façon automatique.

J'y ai pensé mais ces données seront utilisées dans une macro (que je n'ai pas créée) et je ne sais pas trop si j'arriverai à avoir le même fonctionnement après.

J'ai trouvé un post avec la même demande et un fichier excel pouvant aller ^^.

Par contre ne sachant pas comprendre une macro, j'ai du mal à l'adapter à ma demande (je ne veux pas faire la somme des quantités mais seulement la somme des valeurs dans chaque colonne

11pour-skud-2.xlsm (20.16 Ko)

PS: le fichier n'est pas de moi, j'ai tenté de comprendre la macro mais je ne sais pas quoi modifier pour arriver à mon résultat

Je me permets de rebondir à mes propres messages car j'essaie de pousser l'investigation.

Je ne peux pas utiliser un TCD --> 32 000 lignes + 4 colonnes (j'ai un message d'erreur en permanence concernant la mémoire pour réaliser l'opération.

Je pense vraiment que le fichier excel en PJ est ma solution mais je ne comprends pas trop comment le modifier

Bonjour et bienvenue,

Aurais-tu un bout de fichier ?

Il y a 2 solutions mon sens (la 4ème étant le TCD que tu ne souhaites pas, dommage)

  • > faire des sous-totaux
  • > faire par VBA ce que tu demandes, c'est pas bien compliqué

Si par contre tu voulais juste alléger la lecture, une MFC permet de ne pas répéter les mêmes valeurs !

Sub regrouper()
'
' regrouper Macro
'

'
    ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau1").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau1").Sort.SortFields. _
        Add Key:=Range("Tableau1[[#Headers],[item]]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    old = "": iold = 0
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1) <> old Then
            old = Cells(i, 1): iold = i
        Else
            For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
                Cells(iold, j) = Cells(iold, j) + Cells(i, j)
            Next
        End If
    Next

    For i = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
        If Cells(i, 1) = Cells(i - 1, 1) Then Rows(i).Delete Shift:=xlUp
    Next

End Sub
14regrouper.xlsm (17.73 Ko)

J'ai pris connaissance de ta macro, je pense que le nom des colonnes ne sont pas bonnes par rapport à mes 32 000 lignes mais ta macro fait exactement ce que je cherche à faire ^^.

PS: J'ai répondu un peu avant ta publication il me semble

J'ai pris connaissance de ta macro, je pense que le nom des colonnes ne sont pas bonnes

ah oui, mais je n'ai pas réussi à copier à partir de ton image ... je plaisante un peu mais un fichier aurait été plus performant pour nous

mais ta macro fait exactement ce que je cherche à faire ^^.

J'ai pris connaissance de ta macro, je pense que le nom des colonnes ne sont pas bonnes

ah oui, mais je n'ai pas réussi à copier à partir de ton image ... je plaisante un peu mais un fichier aurait été plus performant pour nous

mais ta macro fait exactement ce que je cherche à faire ^^.

OUPPSSSSS my bad ... j'ai oublié le fichier et je me rends compte que mon message n'a jamais été envoyé

Le fichier est en PJ:

Actuel --> Même nombre de colonne que mon vrai fichier / Nombre de lignes moins importante (j'ai 32 000)

Suuhaité --> Le merge que je souhaite avoir (ce que ta maccro propose)

Je pensais que les CHSCT avaient été remplacés par les CSE !

Je te confirme que les CHSCT et les CE vont disparaitre au profit des CSE ^^

Merci pour la macro, je n'ai pas encore pu la tester car je suis en déplacement mais je ne manquerai pas de te faire un retour

CHSCT

dont j'ai assuré la présidence un certain temps ...

Bonsoir à tous,

Via un dico :

Option Explicit
Sub test()
Dim a, i As Long, j As Long, n As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    n = 1
    a = Sheets("Actuel").Range("a1").CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dico.Exists(a(i, 14)) Then
            n = n + 1
            For j = 1 To UBound(a, 2)
                a(n, j) = a(i, j)
            Next
            dico(a(i, 14)) = n
        Else
            For j = 15 To UBound(a, 2)
                a(dico(a(i, 14)), j) = a(dico(a(i, 14)), j) + a(i, j)
            Next
        End If
    Next
    With Sheets("Souhaité").Range("a1")
        .CurrentRegion.ClearContents
        .Resize(n, UBound(a, 2)).Value = a
    End With
    Set dico = Nothing
End Sub

klin89

Rechercher des sujets similaires à "fusionner lignes seule additionner valeur colonne"