Recherche et extraction de données multiples

mvcs

XLDnaute Nouveau
Bonjour à tous,
Je suis un peu novice avec Excel. Cela fait quelques heures que je passe de sujets en sujets dans les forums et après avoir bidouillé plusieurs formules, j'avoue baisser les bras et avoir besoin d'aide. :confused:
Pourtant mon problème à l'air plutôt simple. Je ne doute pas qu'un des experts présents sur ce forum agira avec sa baguette magique pour m'apporter la solution.Ce sera de bonne augure en cette période de Noël ... :)
Il s'agit d'extraire les données d'un tableau pour les trier dans un autre tableau en les classant par catégorie.
Je joins un fichier illustrant l'objectif.
Merci par avance à ceux ou celles qui m'apporteront son concours.
 

Pièces jointes

  • recherche et extraction.xlsx
    10 KB · Affichages: 39

youky(BJ)

XLDnaute Barbatruc
Re : Recherche et extraction de données multiples

Bonjour,
J'ai fait avec une macro, donc bienvenu dans la prise de tête des macros . . .
Quelques explication dans le fichier
Bruno
 

Pièces jointes

  • recherche et extraction.xlsm
    16.2 KB · Affichages: 38

job75

XLDnaute Barbatruc
Re : Recherche et extraction de données multiples

Bonjour mvcs, Bruno,

Formule matricielle en E3 à tirer à droite et vers le bas :

Code:
=SUPPRESPACE(INDEX($A:$A;PETITE.VALEUR(SI($C$1:$C$100=E$2;LIGNE($C$1:$C$100));LIGNE(A1)))&" "&INDEX($B:$B;PETITE.VALEUR(SI($C$1:$C$100=E$2;LIGNE($C$1:$C$100));LIGNE(A1))))
100 à adapter en fonction du tableau.

Les valeurs d'erreur sont masquées par MFC.

Fichier joint.

A+
 

Pièces jointes

  • recherche et extraction(1).xlsx
    12 KB · Affichages: 39

job75

XLDnaute Barbatruc
Re : Recherche et extraction de données multiples

Re,

Formule plus simple, toujours matricielle :

Code:
=SUPPRESPACE(INDEX($A$1:$A$100&" "&$B$1:$B$100;PETITE.VALEUR(SI($C$1:$C$100=E$2;LIGNE($C$1:$C$100));LIGNE(A1))))
Fichier (2).

A+
 

Pièces jointes

  • recherche et extraction(2).xlsx
    11.8 KB · Affichages: 39

david84

XLDnaute Barbatruc
Re : Recherche et extraction de données multiples

Bonsoir,
Code:
=SUPPRESPACE(INDEX($A$1:$A$100&" "&$B$1:$B$100;PETITE.VALEUR(SI($C$1:$C$100=E$2;LIGNE($C$1:$C$100));LIGNE(A1))))
@Gérard : tu peux peut-être simplifier encore (SUPPRESPACE a-t-il un intérêt) ?
A+
 

klin89

XLDnaute Accro
Re : Recherche et extraction de données multiples

Bonsoir david84, job75, youky(BJ), mvcs
Bonsoir le forum, :)

Version VBA : résultat en Feuil1 :
VB:
Option Explicit
Sub Transpose()
Dim a, i As Long, j As Long, x, derLig As Long
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Cells(1).CurrentRegion
        a = .Value
        With CreateObject("System.Collections.SortedList")
            For i = 3 To UBound(a, 1)
               'a(i, 3) = StrConv(a(i, 3), vbUpperCase)
                .Item(a(i, 3)) = .Item(a(i, 3)) & Chr(2) & a(i, 1) & " " & a(i, 2)
                derLig = Application.Max(derLig, _
                                         UBound(Split(Mid$(.Item(a(i, 3)), 2), Chr(2))))
            Next
            ReDim a(1 To derLig + 2, 1 To .Count)
            For i = 0 To .Count - 1
                a(1, i + 1) = .GetKey(i)
            Next
            For i = 0 To .Count - 1
                x = Split(Mid$(.GetByIndex(i), 2), Chr(2))
                For j = 0 To UBound(x)
                    a(j + 2, i + 1) = x(j)
                Next
            Next
        End With
        'Résultat dans la même feuille
        With .Offset(1, .Columns.Count + 5).Resize(UBound(a, 1), UBound(a, 2))
            .CurrentRegion.Clear
            .Value = a
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .BorderAround ColorIndex:=1, Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround ColorIndex:=1, Weight:=xlThin
                .Interior.ColorIndex = 15
            End With
            .Columns(1).Resize(, .Columns.Count).ColumnWidth = 8
        End With
    End With
    Application.ScreenUpdating = True
End Sub
klin89
 

Pièces jointes

  • mvcs1.xls
    46.5 KB · Affichages: 30
Dernière édition:

klin89

XLDnaute Accro
Re : Recherche et extraction de données multiples

Re le forum,

Autre version : remarquez que le champ "type" n'est pas trié
VB:
Sub Transpose1()
Dim a, i As Long, w, n As Long, derLig As Long, e
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Cells(1).CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 3 To UBound(a, 1)
                If Not .exists(a(i, 3)) Then
                    .Item(a(i, 3)) = VBA.Array(a(i, 3))
                End If
                w = .Item(a(i, 3))
                ReDim Preserve w(UBound(w) + 1)
                w(UBound(w)) = a(i, 1) & " " & a(i, 2)
                .Item(a(i, 3)) = w
                derLig = Application.Max(derLig, UBound(w) + 1)
            Next
            ReDim a(1 To derLig, 1 To .Count)
            For Each e In .items
                n = n + 1
                For i = 0 To UBound(e)
                    a(i + 1, n) = e(i)
                Next
            Next
        End With
        With .Offset(1, .Columns.Count + 5).Resize(derLig, n)
            .CurrentRegion.Clear
            .Value = a
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .BorderAround ColorIndex:=1, Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround ColorIndex:=1, Weight:=xlThin
                .Interior.ColorIndex = 15
            End With
            .Columns(1).Resize(, .Columns.Count).ColumnWidth = 8
        End With
    End With
    Application.ScreenUpdating = False
End Sub
klin89
 
Dernière édition:

mvcs

XLDnaute Nouveau
Re : Recherche et extraction de données multiples

Bonsoir,
Mille fois merci à youki, job75, david84 et klin89 de vous être penchés sur mon cas.
Les deux versions, matricielles ou macro, sont intéressantes ... j'hésite.
En fonction de l'utilisation finale que je vais en faire, j'ai une petite préférence pour la formule matricielle car la macro oblige à une manipulation pour l'exécuter alors que la formule remplit automatiquement.
Mais la macro de Youri me plait bien par sa simplicité et ça me donne envie de me former sur les macros un peu mieux.
Merci encore pour votre travail aussi rapide et efficace. Je suis impressionné, jamais je n'aurais trouvé ça tout seul.
J'ai juste ajouté devant la formule de job75 =SIERREUR(SUPPRESPACE(.........);"") pour éviter de gérer les erreurs par la mise en forme conditionnelle (ci-joint fichier).
Bonne continuation et passez de bonnes fêtes de fin d'année.
mvcs
 

Pièces jointes

  • recherche et extraction(3).xlsx
    11 KB · Affichages: 32

youky(BJ)

XLDnaute Barbatruc
Re : Recherche et extraction de données multiples

Bonjour à tous,
mvcs, si tu veux avoir le tableau à jour à chaque ajout ou modif c'est facile. . .

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range(Target.Address), Range("A3:C19")) Is Nothing Then MonTri
End Sub

Pour écrire ceci click avec le bouton droit de la souris sur le nom de l'onglet et Visualiser le code.
Dans la liste à la place de Général choisir Worksheet et à droite au lieu de Selection_Change choisir Change
Entre les nouvelles lignes copie simplement ceci
If Not Intersect(Range(Target.Address), Range("A3:C19")) Is Nothing Then MonTri

Tu peux en profiter pour voir tous les événements qui exécutent les macros.....
C'est bon d'essayer cela fait un bon test pour un début. C'est pour ça que j'ai pas mis le fichier.
Bruno
Bruno
 

mvcs

XLDnaute Nouveau
Re : Recherche et extraction de données multiples

Bonjour Bruno,
Merci du tuyau, je vais essayer ça.
Petite question subsidiaire : je conçois mon fichier à la maison sur Excel2007 mais c'est pour l'installer sur un autre ordi au travail qui n'est pas un PC mais un client léger sur un serveur, installé avec Office2013.
N'y aura-t-il pas de souci sur la compatibilité des macros ?
J'ai également une petite crainte sur le serveur qui risque bien de me bloquer la macro. Nous avons au boulot un service informatique très rigide sur la sécurité informatique qui met des verrouillages de partout sans trop d'ouverture d'esprit ...
C'est pour ça que j'avais envisagé plutôt la solution formule matricielle.
Merci encore et bonne fin d'année.
Manu
 

Statistiques des forums

Discussions
312 198
Messages
2 086 153
Membres
103 137
dernier inscrit
Billly