XL 2016 Extraction de données selon critères

lajoie25

XLDnaute Nouveau
Bonjour;

j'ai une base de données dans une feuille.
Je veux découper la base de données selon plusieurs critères.

Dans le fichier joint,
- je veux extraire dans la "feuille resultat 1" à partir de la "feuille base" les "N° COMPTE" commençant par "205" en plaçant le premier numéro dans la "cellule C6", puis ajuster le cadre à la hauteur de tous les numéros extraits

- je veux extraire dans la "feuille resultat 2" à partir de la "feuille base" les "N° COMPTE" commençant par "3" en plaçant le premier numéro dans la "cellule C6", puis ajuster le cadre à la hauteur de tous les numéros extraits

- je veux extraire dans la "feuille resultat 3" à partir de la "feuille base" les "N° COMPTE" commençant par "44" en plaçant le premier numéro dans la "cellule C6", puis ajuster le cadre à la hauteur de tous les numéros extraits

J'ai voulu utiliser STXT mais j'ai du mal obtenir le bon résultat.
 

Pièces jointes

  • EXTRACTION DE DONNEES.xlsx
    19.4 KB · Affichages: 6

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Lajoie, bonjour le forum,

En convertissant tous les tableaux en tableaux structurés et le code ci-dessous :

VB:
Option Explicit 'oblige à déclarere toutes les variables

Sub Macro1()
Dim OB As Worksheet 'déclare la variable OB (Onglet Base)
Dim ORe(1 To 3) As Worksheet 'déclare la tableau de 3 variables (ORe(1) à ORe(3))
Dim TB As ListObject 'déclare la variable TB (Tableu structué Base)
Dim T2 As ListObject 'déclare la variable T2 (Tableau Structuré 2)
Dim T3 As ListObject 'déclare la variable T3 (Tableau Structuré 3)
Dim T4 As ListObject 'déclare la variable T4 (Tableau Structuré 4)
Dim I As Integer 'déclare la variable I (Incrément)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set OB = Worksheets("Base") 'définit l'onglet base OB
For I = 1 To 3 'boucle sur 3 éléments
    Set ORe(I) = Worksheets("Resultat (" & I & ")") 'définit l'onglet Ore(I) de la boucle
Next I 'prochain élément de la boucle
Set TB = OB.ListObjects(1) 'définit le tableau structuré TB
Set T2 = ORe(1).ListObjects(1) 'définit le tableau structuré T2
Set T3 = ORe(2).ListObjects(1) 'définit le tableau structuré T3
Set T4 = ORe(3).ListObjects(1) 'définit le tableau structuré T4
For I = 1 To TB.ListRows.Count 'boucle sur toutes les lignes I du tableau structuré TB
    Select Case Left(TB.DataBodyRange(I, 1), 3) 'agit en fonction des 3 premiers caractères du Nº de compte de la boucle
        Case "205" 'cas 205
            Set R = T2.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de T2)
            If R Is Nothing Or T2.ListRows Is Nothing Then 'condition : si aucune occurrence trouvée ou si T2 n'a pas encore de ligne
                T2.ListRows.Add , True 'ajoute une ligne en décalant le total vers le bas
                LI = T2.ListRows.Count 'définit la ligne LI
            Else 'sinon (au moins une occurrence trouvée)
                LI = R.Row - T2.HeaderRowRange.Row 'définit la ligne LI de la première occurrence trouvée - la ligne des en-têtes de T2
            End If 'fin de la condition
            T2.DataBodyRange(LI, 1) = TB.DataBodyRange(I, 1) 'récupère le Nº de compte
            T2.DataBodyRange(LI, 2) = TB.DataBodyRange(I, 2) 'récupère le libellé
            T2.DataBodyRange(LI, 3) = TB.DataBodyRange(I, 5) 'récupère le solde
        Case "300" To "399" 'cas 300 à 399
            Set R = T3.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de T3)
            If R Is Nothing Or T3.ListRows Is Nothing Then 'condition : si aucune occurrence trouvée ou si T3 n'a pas encore de ligne
                T3.ListRows.Add , True 'ajoute une ligne en décalant le total vers le bas
                LI = T3.ListRows.Count 'définit la ligne LI
            Else 'sinon (au moins une occurrence trouvée)
                LI = R.Row - T3.HeaderRowRange.Row 'définit la ligne LI de la première occurrence trouvée - la ligne des en-têtes de T3
            End If 'fin de la condition
            T3.DataBodyRange(LI, 1) = TB.DataBodyRange(I, 1) 'récupère le Nº de compte
            T3.DataBodyRange(LI, 2) = TB.DataBodyRange(I, 2)
            T3.DataBodyRange(LI, 3) = TB.DataBodyRange(I, 5)
        Case "440" To "449"
            Set R = T4.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de T4)
            If R Is Nothing Or T4.ListRows Is Nothing Then 'condition : si aucune occurrence trouvée ou si T4 n'a pas encore de ligne
                T4.ListRows.Add , True 'ajoute une ligne en décalant le total vers le bas
                LI = T4.ListRows.Count 'définit la ligne LI
            Else 'sinon (au moins une occurrence trouvée)
                LI = R.Row - T4.HeaderRowRange.Row 'définit la ligne LI de la première occurrence trouvée - la ligne des en-têtes de T4
            End If 'fin de la condition
            T4.DataBodyRange(LI, 1) = TB.DataBodyRange(I, 1) 'récupère le Nº de compte
            T4.DataBodyRange(LI, 2) = TB.DataBodyRange(I, 2) 'récupère le libellé
            T4.DataBodyRange(LI, 3) = TB.DataBodyRange(I, 5) 'récupère le solde
    End Select 'fin de l 'action en fonction des 3 premiers caractères du Nº de compte de la boucle
Next I 'prochaine ligne de la boucle
End Sub
 

Pièces jointes

  • Lajoie_EP_v01.xlsm
    32.6 KB · Affichages: 15

Discussions similaires