rassembler les doublons

[an@s]

Bonjour à tous,

dans l'exemple ci-joint un code dans la feuille RECAP qui permet en premier lieu d'importer les informations de chaque feuille en commençant par 210 et les mettre dans le tableau de la feuille RECAP.

le 2ème rôle de ce code consiste à mettre jour le tableau de la feuille Synthèse en se basant sur celui de la feuille RECAP...

le code fonctionne bien mais j'aimerai faire une petite modification en faisant ceci :

en cliquant sur la feuille Synthèse je veux que le code rassemble les lignes dont les cellules de la colonne C sont les mêmes en une seule ligne, et les valeurs des colonnes E jusqu'à M sera la somme des lignes rassemblées.
exemple (lignes 11 & 12, 13 & 15, 10 & 17, 18-19-20-21-22-23)

NB: je n'ai pas de problème de ne plus avoir les formules dans le tableau de la feuilel synthèse et d'avoir juste des valeurs

Merci d'avance pour votre assistance

 

[Bebere]

bonsoir
an une proposition

Sub Rassemble()    'outils,références cocher microsoft scripting runtime
    Dim tbl(), a(), d As New Dictionary, i As Long, j As Long, c As Byte, item As Variant
    tbl = Feuil2.Range("C10:M23")    'synthèse
    For i = 1 To UBound(tbl)
        Set d(tbl(i, 1)) = tbl(i, 1)
        For c = 2 To UBound(tbl, 2)
            If tbl(i, c) = "" Then tbl(i, c) = 0
        Next
    Next
    ReDim Preserve a(1 To d.Count, 1 To 11)
    For Each item In d.Items
        j = j + 1: a(j, 1) = item
        For c = 2 To UBound(a, 2)
            a(j, c) = 0
        Next
    Next
    For j = 1 To UBound(a)
        For i = 1 To UBound(tbl)
            If tbl(i, 1) = a(j, 1) Then
                For c = 2 To UBound(tbl, 2)
                    a(j, c) = a(j, c) + tbl(i, c)
                Next
            End If
        Next
    Next

    Feuil2.Range("C30").Resize(UBound(a, 1), UBound(a, 2)) = a
   
End Sub

rmq:tu devrais t'arranger pour avoir des 0 avec les formules dans la feuille

 

[an@s]

Bonsoir bebere,

merci pour votre réponse...
après un test je constate que le code renvoie une erreur sur la 2ème ligne et plus précisément
d As New Dictionary
de plus le code doit être variable c'est à dire le tableau peut finir dans la ligne 30 ou 40 et non pas toujours la ligne 23 comme dans mon exemple

Cordialement
An@s

 

[Staple1600]

Bonsoir

@an@s
Est-ce que tu as fait ce qui était écrit dans le commentaire du code de Bebere?

'outils,références cocher microsoft scripting runtime

Ce menu est dans VBE
Depuis Excel, faire ALT+F11

 

[an@s]

Bonjour Stapple, Bisson nicole
je viens de tester et ça ne fonctionne pas...
entre autre en cliquant juste sur l'onglet synthèse le code doit s’exécuter sans le lier à un bouton

Nicole merci pour le code mais ce n'est pas du tout ce que j'ai demandé, je n'ai pas besoin de créer un autre tableau

Cordialement

 

[Staple1600]

Re

@an@s
Tu as bien coché les références comme je le rappelais en détail dans le message#4 ?

PS: Tu es sur PC ou sur Mac?

 

[an@s]

re Staple,
oui j'ai bien coché les références mais ça na pas fonctionné,
je suis sous windows 7

Amicalement

 

[Staple1600]

Re

je viens de tester et ça ne fonctionne pas...
entre autre en cliquant juste sur l'onglet synthèse le code doit s’exécuter sans le lier à un bouton

Tu as testé le fichier de BISSON?
Ce serait étonnant qu'il ne fonctionne pas.

Et où à tu mis le code de Bebere?

D'après ce que tu dis, tu voudrais que le code soit dans un procédure événementielle.
Or les codes de Bebere ou Bisson tels quels se lancent par le biais d'un bouton ou par Développeur/Macros

Il faut donc adapter le code et le mettre dans le code de la feuille dans la procédure
Private Sub Worksheet_Activate()

 

[an@s]

Re Staple,
je suis nul en VBA pour adapter l'un des codes à celui que j'ai sur mon fichier.
le code de bebere je l'ai mis dans un module
puis le fichier de boisson il crée un autre tableau sous celui que j'ai dans la feuille synthèse..

bien évidement ce que je souhaite c'est une fois je clique sur mise à jour la modification se fait dedans,
si non en cliquant sur l'onglet synthèse le code s'éxecute

cordialement

 

[job75]

Bonjour an@s, bebere, JM, Nicole,

le tableau peut finir dans la ligne 30 ou 40 et non pas toujours la ligne 23 comme dans mon exemple

Alors vraiment pas besoin de se compliquer la vie, à placer dans le code de la feuille "SYNTHESE" :

Private Sub Worksheet_Activate()
Dim i&, j%
Application.ScreenUpdating = False
Call Maj
With [C10].CurrentRegion.Resize(, 14) 'colonnes C à P
  .Value = .Value 'supprime les formules
  .Sort .Cells(1), xlAscending, Header:=xlNo 'tri sur la 1ère colonne
  For i = .Rows.Count To 2 Step -1
    If .Cells(i, 1) = .Cells(i - 1, 1) Then
      For j = 3 To 11 'colonnes E à M
        If IsNumeric(CStr(.Cells(i, j))) Then .Cells(i - 1, j) = .Cells(i, j) + Val(Replace(.Cells(i - 1, j), ",", "."))
      Next
      .Rows(i).EntireRow.Delete 'suppression de la ligne doublon
    End If
  Next
End With
End Sub

Fichier joint, activer la feuille "SYNTHESE".

A+

 

[job75]

Re,

A la fin de la macro MAJ il y avait un Application.ScreenUpdating = True.

Je l'ai supprimé, il était non seulement inutile mais surtout gênant...

A+

 

[an@s]

Bonsoir Job,
merci beaucoup c'est exactement ce que je voulais même si ça prend quelques secondes pour s'éxecuter...
le code fonctionne très bien

Cordialement
An@s

 

[job75]

Re,

Quelques secondes ? Chez moi sur l'exemple 0,43 seconde.

C'est votre macro MAJ qui prend du temps, et je suis bien obligé de l'appeler.

A+

 

[Bebere]

bonsoir
An le fichier avec le code évènement activate de synthèse
tu nous diras si cela a fonctionné

ps demain je regarde pour faire à partir de recap
je viens d'essayer avec maj et çà plante(la ligne total disparait)

 

[job75]

Re,

En toute logique on utilisera aussi dans la feuille "RECAP" :

Private Sub Worksheet_Activate()
Call Maj
End Sub

et on supprimera le bouton.

A+