XL pour MAC Créer un sous groupe à partir d'un groupe

Laurent78 à dit:

Bonjour,
Avec ce genre de formule : =FILTRE($E$4:$E$17;$D$4:$D$17=J3)
à vérifier si cela fonctionne sur Mac (je n'en ai pas sous la main...)

Cliquez pour agrandir...

rtlv17 à dit:

Bonjour Laurent78 et merci beaucoup.

Le fichier joint fonctionne bien sur Mac ;
Il me reste à l'intégrer dans mon appli.

rtlv17

Cliquez pour agrandir...

mapomme à dit:

Bonjour à tous🙂,

Avec une formule matricielle en J4 à copier vers la droite et vers le bas :

VB:

=SIERREUR(INDEX($E:$E;PETITE.VALEUR(SI(SI($D$1:$D$23=J$3;EQUIV($E$1:$E$23;$E$1:$E$23;0);"")=LIGNE($D$1:$D$23);LIGNE($D$1:$D$23);"");LIGNES($1:1)));"")

nota : la formule ôte les doublons dans chaque colonne du résultat.

Regarde la pièce jointe 1220491

Cliquez pour agrandir...

mapomme à dit:

Bonjour à tous🙂,

Avec une formule matricielle en J4 à copier vers la droite et vers le bas :

VB:

=SIERREUR(INDEX($E:$E;PETITE.VALEUR(SI(SI($D$1:$D$23=J$3;EQUIV($E$1:$E$23;$E$1:$E$23;0);"")=LIGNE($D$1:$D$23);LIGNE($D$1:$D$23);"");LIGNES($1:1)));"")

nota : la formule ôte les doublons dans chaque colonne du résultat.

Regarde la pièce jointe 1220491

Cliquez pour agrandir...

mapomme à dit:

Re,

Il faut toujours fournir un petit classeur exemple qui est le reflet fidèle de la structure de votre classeur source. Il faut aussi, dans ce petit classeur exemple, fournir un exemple de résultat conforme à ce qu'on désire.

Sans quoi, on part dans des allers-retours "demandeurs/répondeurs" répétitifs qui vont vite lasser les répondeurs.

Pour ce que vous souhaitez, il faut bien sûr ne pas éliminer les doublons. Les formules ont été revues et, comme on conserve les doublons, les formules sont devenues plus simples.

Quelques explications sont aussi fournies sur la feuille "Tableau de bord". Les formule fournies prennent en compte les lignes du "Journal" jusqu'à la ligne 2000.

Cliquez pour agrandir...

rtlv17 à dit:

De préférence une formule car je ne suis pas expert en VBA

Cliquez pour agrandir...

Sub Filtre_comptes()
'---se lance par les touches Ctrl+F---
Dim dest As Range, tablo, d As Object, col%, c As Range, x$, n&, resu(), i&, y$, nn&, v
Set dest = Sheets("Matrice").[BX3].CurrentRegion
With Sheets("Journal")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    tablo = .Range("B7:I" & .Cells(Rows.Count, 2).End(xlUp).Row) 'matrice, plus rapide
End With
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For col = 1 To dest.Columns.Count Step 2
    Set c = dest.Cells(1, col)
    x = LCase(Trim(c))
    n = 0
    ReDim resu(1 To UBound(tablo), 1 To 2) 'réinitialise le tableau des résultats
    For i = 1 To UBound(tablo)
        If LCase(Trim(tablo(i, 2))) = x Then
            y = Trim(tablo(i, 3))
            If Not d.exists(y) Then
                n = n + 1
                d(y) = n 'mémorise la ligne
                resu(n, 1) = y
            End If
            nn = d(y)
            v = tablo(i, 8)
            If IsNumeric(v) Then resu(nn, 2) = resu(nn, 2) + CDbl(v)
        End If
    Next i
    If n Then c(2).Resize(n, 2) = resu 'restitution
    c(2).Offset(n).Resize(Rows.Count - n - c.Row, 2).ClearContents 'RAZ en dessous
Next col
dest.CurrentRegion.Columns.AutoFit 'ajustement largeurs
dest.Parent.Visible = xlSheetVisible 'au cas où
Application.Goto dest 'active la feuille
dest(1).Select
End Sub

job75 à dit:

Bonjour rtlv17, le forum,

Voici une solution VBA, si elle ne vous intéresse pas elle pourra en intéresser d'autres.

La macro se lance par les touches Ctrl+F :

VB:

Sub Filtre_comptes()
'---se lance par les touches Ctrl+F---
Dim dest As Range, tablo, d As Object, col%, c As Range, x$, n&, resu(), i&, y$, nn&, v
Set dest = Sheets("Matrice").[BX3].CurrentRegion
With Sheets("Journal")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    tablo = .Range("B7:I" & .Cells(Rows.Count, 2).End(xlUp).Row) 'matrice, plus rapide
End With
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For col = 1 To dest.Columns.Count Step 2
    Set c = dest.Cells(1, col)
    x = LCase(Trim(c))
    n = 0
    ReDim resu(1 To UBound(tablo), 1 To 2) 'réinitialise le tableau des résultats
    For i = 1 To UBound(tablo)
        If LCase(Trim(tablo(i, 2))) = x Then
            y = Trim(tablo(i, 3))
            If Not d.exists(y) Then
                n = n + 1
                d(y) = n 'mémorise la ligne
                resu(n, 1) = y
            End If
            nn = d(y)
            v = tablo(i, 8)
            If IsNumeric(v) Then resu(nn, 2) = resu(nn, 2) + CDbl(v)
        End If
    Next i
    If n Then c(2).Resize(n, 2) = resu 'restitution
    c(2).Offset(n).Resize(Rows.Count - n - c.Row, 2).ClearContents 'RAZ en dessous
Next col
dest.CurrentRegion.Columns.AutoFit 'ajustement largeurs
dest.Parent.Visible = xlSheetVisible 'au cas où
Application.Goto dest 'active la feuille
dest(1).Select
End Sub

A+

Cliquez pour agrandir...

job75 à dit:

Bonjour rtlv17, le forum,

Ma macro est adaptée au fichier que vous avez déposé au post #10.

Si celui-ci ne correspond pas au fichier réel pourquoi l'avoir déposé ?

A+

Cliquez pour agrandir...