Concaténer des lignes selon deux critères

Bonjour à tous,

Je reviens encore une fois vers vous afin de vous demander de l'aide sur une macro que je suis entrain de développer.

J'ai un code ci qui me permet de concaténer des lignes si la valeur à la colonne A est identique, j'aimerais si possible mettre une deuxième condition pour dire qu'il faut concaténer les lignes ayant les deux commun les valeurs à la colonne A et H.

Je vous mets ci joint un exemple de tableau qui se rapproche de ce sur quoi je travaille ainsi que le code que j'utilise pour l'instant pour concaténer uniquement si la valeur à la colonne A est identique.

En vous remerciant par avance et en vous souhaitant une bonne journée.

Cordialement,

16aa.xlsm (18.37 Ko)

Dans le cas où le résultat attendu n'est pas clair, vous trouverez ci joint une deuxième feuille de calcul où j'ai mis ce que j'attendais de cette macro.

Je vous remercie.

11aa.xlsm (21.47 Ko)

Bonjour,

tu pourrais utiliser un Tableau croisé dynamique,

voici un exemple

Bonjour,

Je vous remercie pour votre retour, le principe de ce que je cherche à faire est d'alléger l'ensemble vu qu'en vrai j'ai un tableau avec des centaines de milliers de lignes.

L'inconvénient du TCD c'est qu'au moment où on supprime des lignes du tableau source et qu'on actualise le TCD les informations qui y figuraient disparaissent.

Bonne soirée à vous.

re,

à tester,

Sub rapport()
'activer la référence "Microsoft Scripting Runtime"

Dim Dico As New Scripting.Dictionary
Set sh = Sheets("Résultat attendu")
sh.Rows("2:100000").ClearContents

tbl = Sheets("Tabelle1").Range("base").Value

For i = 2 To UBound(tbl)
    Cle = tbl(i, 2) & "-" & tbl(i, 8)
    If Not Dico.Exists(Cle) Then Dico.Add Cle, i
Next

For Each it In Dico.Items
    rw = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
    For k = 1 To 10
        sh.Cells(rw, k) = tbl(it, k)
    Next
Next
sh.Range("K2:K" & rw).Formula = "=SUMPRODUCT((Tabelle1!B2:B100000=B2)*(Tabelle1!H2:H100000=H2)*(Tabelle1!K2:K100000))"
End Sub

Bonjour,

Je vous remercie encore une fois de votre retour. J'ai pu tester ce que vous m'avez envoyé, je ne comprends pas pourquoi ça ne marche pas.

Je ne comprends pas les deux lignes suivantes :

< Dim Dico As New Scripting.Dictionary > sur lequel le débogueur m'indique "Type défini par l’utilisateur non défini"

< tbl = Sheets("Tabelle1").Range("base").Value > où je ne comprends pas le "Range("base").Value " sur lequel le débogueur m'indique "Erreur définie par l'application ou par l'objet"

Bonne journée à vous

J'ai pu bidouiller un peu le code que quelqu'un m'a donné pour donner ce qui suit:

Sub A()

Application.ScreenUpdating = False

iRow = Range("A" & Rows.Count).End(xlUp).Row
iCol = Cells(1, Columns.Count).End(xlToLeft).Column
Range("A1").Resize(iRow, iCol).Sort key1:=Range("A2"), order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
tTab = Range("A1").Resize(iRow + 1, iCol).Value
lgPos = 3
lgPos1 = 2
sItem = tTab(2, 1)
fItem = tTab(2, 8)
Do
   If tTab(lgPos, 1) = sItem And tTab(lgPos, 8) = fItem Then tTab(lgPos - 1, 1) = ""

     If tTab(lgPos, 1) <> sItem Then
        dbTot = 0
        For Y = lgPos1 To lgPos - 1

        dbTot = dbTot + CDbl(tTab(Y, UBound(tTab, 2)))

        Next
        tTab(lgPos - 1, UBound(tTab, 2)) = dbTot
        lgPos1 = lgPos
        sItem = tTab(lgPos, 1)
    End If
    lgPos = lgPos + 1
Loop Until lgPos > UBound(tTab, 1)
With Worksheets("tabelle1")
    .Range("A1").Resize(iRow, iCol).Value = tTab

    .Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Shift:=xlUp

    .Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
    .Range("A1").Resize(1, iCol).Interior.ColorIndex = 15
    .Columns.AutoFit
    .Activate
End With

End Sub

J'arrive à concaténer au dépend des deux critères colonne A et colonne H mais le résultat à la colonne K est incohérent parce que à chaque fois que je fait tourner la macro la somme de toutes les valeurs à la colonne K des lignes ayant la même valeur à la colonne A viennent s'additionner à la dernière ligne ayant cette valeur à la colonne A et à chaque fois que je fais tourner la macro les valeurs ayant la même valeur à la colonne A sans avoir la même valeur à la colonne H viennent s'additionner encore et encore.

Je ne sais pas si ce que je dis est clair, moi même je suis perdu

Bonne journée à tous.

Je vous remercie encore une fois de votre retour. J'ai pu tester ce que vous m'avez envoyé, je ne comprends pas pourquoi ça ne marche pas.

Je ne comprends pas les deux lignes suivantes :

< Dim Dico As New Scripting.Dictionary > sur lequel le débogueur m'indique "Type défini par l’utilisateur non défini"

as-tu activer la référence "Microsoft Scripting Runtime" ?

Rechercher des sujets similaires à "concatener lignes deux criteres"