Rassembler les mêmes valeurs

[henrikwasabi]

Bonjour, j'ai un petit problème sur excel,

Je veux rassembler les mêmes valeurs qui se trouve dans ma "matriceX"

J'aimerais le faire automatiquement sans aucune manip' a faire malheureusement je n'ai rien trouvé pour cela, j'ai juste trouvé une macro qui me permet de le faire, c'est presque automatique. Mon problème c'est quand dans cette macro je dois faire ma sélection manuellement.

Ma question, est ce qu'il est possible dans modifier le code pour choisir directement ma matrice et non que je face la sélection moi même ? (test 1)

Deuxième question, est-il possible de faire tourner la macro une seul fois mais que je puisse sélectionner plusieurs matrice différentes et donc rassembler plusieurs tableaux différents ? (test 2)

Troisième question, est-ce qu'il y a un autre moyen de le faire sans macro automatiquement sans aucune manip ?

Test 1 :

Avant :

A	B
1​	5​
2​	3​
1​	5​

Résultat :

A	B
1​	10​
2​	3​

macro :

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27

Sub MG30Nov12() 'Updateby20150519 Dim Rng As Range Dim InputRng As Range Dim nRng As Range Set InputRng = Application.Selection Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8) Set InputRng = InputRng.Parent.Range(InputRng.Columns(1).Address) With CreateObject("scripting.dictionary") .CompareMode = vbTextCompare For Each Rng In InputRng If Not .Exists(Rng.Value) Then .Add Rng.Value, Rng.Offset(, 1) Else .Item(Rng.Value).Value = .Item(Rng.Value).Value + Rng.Offset(, 1) If nRng Is Nothing Then Set nRng = Rng Else Set nRng = Union(nRng, Rng) End If End If Next If Not nRng Is Nothing Then nRng.EntireRow.Delete End If End With End Sub

Test 2 :

Avant :

A	B		D	E
1​	5​		OUI	5​
2​	3​		NON	10​
1​	5​		NON	2​

Résultat :

A	B		D	E
1​	10​		OUI	7​
2​	3​		NON	10​

Merci.

 

[Staple1600]

Bonsoir le fil, henrikwasabi

Ci-dessous, ta macro modifiée (sans plus) pour ne pas devoir faire de sélection manuelle.
(test OK avec ton "tableau" Test 1)

Sub MG30Nov12_B()
Dim Rng As Range, InputRng As Range, nRng As Range
Application.ScreenUpdating = False
With [A1].CurrentRegion
Set InputRng = .Parent.Range(.Columns(1).Address)
End With
With CreateObject("scripting.dictionary")
  .CompareMode = vbTextCompare
  For Each Rng In InputRng
    If Not .Exists(Rng.Value) Then
    .Add Rng.Value, Rng.Offset(, 1)
    Else
    .Item(Rng.Value).Value = .Item(Rng.Value).Value + Rng.Offset(, 1)
      If nRng Is Nothing Then
      Set nRng = Rng
      Else
      Set nRng = Union(nRng, Rng)
      End If
    End If
    Next
  If Not nRng Is Nothing Then
  nRng.EntireRow.Delete
  End If
End With
End Sub

EDITION: Bonsoir job75

 

[job75]

Bonsoir henrikwasabi, JM,

Renseignez-vous sur la commande Consolider du menu DONNÉES.

A+

Edit : ce message est inutile car ici il ne s'agit pas d'une consolidation.

 

[job75]

Bonjour henrikwasabi, JM,

Une solution par formules dans le fichier joint.

Belle formule en H9, à tirer à droite et vers le bas :

=SI($G9="";"";SIERREUR(EXP(LN(SOMME.SI(INDIRECT("Tableau2[Titre1]");$G9;Tableau2[Titre2])));""&INDEX(Tableau2[Titre2];EQUIV($G9;INDIRECT("Tableau2[Titre1]");0))))

A+

 

[job75]

Fichier joint avec cette solution VBA :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LO As ListObject, P  As Range, ncol%, Q As Range, tablo, d As Object, i&, x$, n&, a, j%
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
For Each LO In ListObjects 'tableaux Excel structurés
    Set P = LO.Range
    ncol = P.Columns.Count
    P.AutoFilter: P.AutoFilter 'si le tableau est filtré
    P.Offset(, ncol).Resize(, Columns.Count - ncol - P.Column + 1).Delete xlToLeft 'RAZ à droite du tableau
    Set Q = P.Offset(, ncol + 1)
    tablo = P 'matrice, plus rapide
    '---liste sans doublon---
    Set d = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tablo)
        x = CStr(tablo(i, 1))
        If x <> "" And Not d.exists(x) Then d(x) = i 'mémorisation de la ligne
    Next
    n = d.Count + 1
    If n > 1 Then
        '---formules SOMME.SI---
        a = d.keys
        For i = 2 To n
            tablo(i, 1) = a(i - 2)
            For j = 2 To ncol
                tablo(i, j) = "=SUMIF(" & P.Columns(1).Address & "," & Q(i, 1).Address & "," & P.Columns(j).Address & ")"
        Next j, i
        Q.Resize(n) = tablo '1ère restitution
        '---élimination des zéros---
        tablo = Q.Resize(n) 'matrice des valeurs, plus rapide
        For i = 2 To n
            For j = 2 To ncol
                If tablo(i, j) = 0 Then tablo(i, j) = P(d(CStr(tablo(i, 1))), j)
        Next j, i
        Q.Resize(n) = tablo '2ème restitution (il n'y a plus de formules)
    End If
    '---mise en forme---
    With Q.Resize(n)
        .Interior.ColorIndex = 36 'jaune clair
        .Borders.Weight = xlHairline 'bordures
        With .Rows(1)
            .Value = P.Rows(1).Value 'en-têtes
            .Interior.ColorIndex = 44 'orange
            .Font.Bold = True 'gras
        End With
    End With
Next
Application.EnableEvents = True 'réactive les évènements
End Sub

A+

 

[henrikwasabi]

Woaw super merci beaucoup pour vos réponses et pour le temps passé à trouver une solution!!

 

[henrikwasabi]

Je comprend ce que fais le code mais je suis vraiment débutant dans ce domaine, j'aimerais le comprendre un petit peu plus pour pouvoir l'affecter à d'autre tableau et à d'autres feuilles.

Ou est la ligne de sélection du tableau à regrouper et comment le code fait pour ce faire automatiquement?
Et est ce que je peux le copier et l'affecter à d'autre feuille et même est ce que je peux l'exécuter et qu'il apparaisse sur un autre feuille?

Merci,

 

[job75]

Ou est la ligne de sélection du tableau à regrouper et comment le code fait pour ce faire automatiquement?

Sachez qu'en VBA il est en général inutile et même nuisible de "sélectionner".

La macro traite chaque tableau Excel structuré grâce à la boucle For Each LO In ListObjects...Next.

 

[job75]

Voyez ce fichier (2) avec les résultats dans la feuille "Regrouper".

La macro est un peu différente et doit être placée dans le code de cette feuille :

Private Sub Worksheet_Activate()
Dim LO As ListObject, P  As Range, ncol%, Q As Range, tablo, d As Object, i&, x$, n&, a, j%
Application.ScreenUpdating = False
Cells.Clear 'RAZ
For Each LO In Sheets("Base").ListObjects 'tableaux Excel structurés
    Set P = LO.Range
    ncol = P.Columns.Count
    P.AutoFilter: P.AutoFilter 'si le tableau est filtré
    Set Q = Range(P.Address) 'même adresse dans les 2 feuilles
    tablo = P 'matrice, plus rapide
    '---liste sans doublon---
    Set d = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tablo)
        x = CStr(tablo(i, 1))
        If x <> "" And Not d.exists(x) Then d(x) = i 'mémorisation de la ligne
    Next
    n = d.Count + 1
    If n > 1 Then
        '---formules SOMME.SI---
        a = d.keys
        For i = 2 To n
            tablo(i, 1) = a(i - 2)
            For j = 2 To ncol
                tablo(i, j) = "=SUMIF(" & P.Columns(1).Address(External:=True) & "," & Q(i, 1).Address & "," & P.Columns(j).Address(External:=True) & ")"
        Next j, i
        Q.Resize(n) = tablo '1ère restitution
        '---élimination des zéros---
        tablo = Q.Resize(n) 'matrice des valeurs, plus rapide
        For i = 2 To n
            For j = 2 To ncol
                If tablo(i, j) = 0 Then tablo(i, j) = P(d(CStr(tablo(i, 1))), j)
        Next j, i
        Q.Resize(n) = tablo '2ème restitution (il n'y a plus de formules)
    End If
    '---mise en forme---
    With Q.Resize(n)
        .Interior.ColorIndex = 36 'jaune clair
        .Borders.Weight = xlHairline 'bordures
        With .Rows(1)
            .Value = P.Rows(1).Value 'en-têtes
            .Interior.ColorIndex = 44 'orange
            .Font.Bold = True 'gras
        End With
    End With
Next
End Sub

Elle se déclenche quand on active la feuille.

 

[henrikwasabi]

D'accord merci mais du coup comment le tableau est détecté pour le regroupement de données ?
Et qu'est ce que vous entendez par le faite "d'activer" la feuille? Il faut aller dessus pour que celle-ci fonctionne ?

Et autre question, je vous transmet mon fichier "fini" et je vous explique mon cas :

Dans ma première feuille "6_Fenêtre_00_Fenetre", ce sont mes données qui sont extrait d'un autre logiciel et qui arrive directement sous cette forme et dans les bonnes colonnes.
Dans la secondes, j'ai reclassé dans le bon ordre pour pouvoir les regrouper après
Et dans le dernier, j'ai le tableau fini de mes valeurs qui devront être regroupées ainsi. (pour l'instant je les rempli à la mains mais c'est lui qui devrait être faire automatiquement)

Donc est-ce que je peux mettre le code que vous avez fait et l'affecter à la feuille 6_Fenêtre_00_Fenetre (T) (soit la dernière feuille) et qui reprendrais les valeurs de la deuxième feuilles?
Est-ce que quand les valeurs vont être remplis automatiquement par l'extraction de donné que je fais sur la première feuille, le code et le regroupement vont se faire automatiquement ?

Et je vais avoir plusieurs fois ce cas la dans d'autres feuilles, comment faire pour me permettre de le refaire? Je devrais affecter le code à chaque feuilles où le regroupement doit ce faire ???

Merci,

 

[job75]

Désolé, il fallait joindre votre fichier dès le début, j'en ai assez fait.

 

[henrikwasabi]

Je n'avais pas encore fait le fichier final, je faisais des tests pour savoir si cela était possible, comme je débute dans excel.
Je ne suis pas programmeur et je comprends pas grand chose au code je voulais donc de l'aide.
Mais bon merci quand même et j'espère que cela va aider des personnes qui peuvent avoir le même problème que moi et qui comprenne plus ce domaine car du coup je ne peux pas l’utiliser comme j'y comprends rien.
Mais bon merci quand même et bonne journée.

 

[job75]

Je ne suis pas programmeur et je comprends pas grand chose au code

Puisque VBA vous dépasse utilisez la solution par formules que j'ai donnée au post #4.

 

[henrikwasabi]

J'ai testé celle-ci ne fonctionne pas à chaque fois.
Mais laissez tomber je vais me débrouiller où aller sur un autre forum.
Merci pour votre aide.

 

[job75]

Je viens d'ouvrir votre dernier fichier et je suis très surpris car c'est l'enfance de l'art par formules !!!

1) Sur la 1ère feuille définir le nom T par =DECALER('6_Fenêtre_00_Fenetre'!$A$1;3;;NBVAL('6_Fenêtre_00_Fenetre'!$A:$A)-2;4)

2) Feuille "Regrouper" formule matricielle en A4 (à tirer vers le bas) :

=SIERREUR(INDEX(T;PETITE.VALEUR(SI(NON(NB.SI(A$3:A3;INDEX(T;;3)));LIGNE(T)-3);1);3);"")

3) Feuille "Regrouper" formule très simple en B4 =SI(A4="";"";INDEX(T;EQUIV(A4;INDEX(T;;3);0);2))

4) Feuille "Regrouper" formule très simple en C4 =SI(A4="";"";SOMME.SI(INDEX(T;;3);A4;INDEX(T;;4)))

Fichier .xlsx joint (pas de VBA).

Vous nous avez fait perdre du temps pour pas grand-chose.