Trier sur des bases de données avec conditions

ecosphere

XLDnaute Nouveau
Bonjour

J'ai cherché des solutions sur divers forum et dans celui ci mais je ne trouve pas la solution à mes 2 problèmes de tri de bases.

J'ai bricolé avec Recherche et BDLire et Index mais ça ne marche pas !!

Merci de votre aide.

Pour être plus clair le fichier Excel est joint !
 

Pièces jointes

  • Classeur BDB.xls
    20.5 KB · Affichages: 77

Robert

XLDnaute Barbatruc
Repose en paix
Re : Trier sur des bases de données avec conditions

Bonjour ecosphère et bienvenu, bonjour le forum,

Est-ce qu'une solution VBA (par macro) pourrait te convenir ou tu ne souhaites qu'une solution par formule ?
 

ecosphere

XLDnaute Nouveau
Re : Trier sur des bases de données avec conditions

Bonjour ecosphère et bienvenu, bonjour le forum,

Est-ce qu'une solution VBA (par macro) pourrait te convenir ou tu ne souhaites qu'une solution par formule ?

Bonjour Robert

Merci de t'intéresser à mon sujet.
De préférence avec formule mais je suis preneur des 2 (formules et VBA), car je cherche une solution.
Par contre je sais activr une macro et l'enregistrer mais je ne connais pas le VBA.

Merci d'avance de tes conseils

Ecosphere
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Trier sur des bases de données avec conditions

Bonjour Écosphère, bonjour le forum,

En pièce jointe ton fichier modifier qu'il faudra certaiment adapter à tes fichiers originaux... Le code est commenté... Un bouton pour chaque action, Tri pour le problème 1 et Récup. pour le problème 2 :
Le code pour Tri :
Code:
Sub Macro1()
Dim o1 As Object 'déclare la variable o1
Dim o2 As Object 'déclare la variable o2
Dim dl As Integer 'déclare la variable dl
Dim pl As Range 'déclare la variable pl
Dim dest As Range 'déclare la variable dest (cellulke de DESTination)

Set o1 = Sheets("Feuil1") 'définit l'onglet o1
Set o2 = Sheets("Feuil2") 'définit l'onglet o2
Application.ScreenUpdating = False 'masque les changements à l'écran
o2.Cells.Clear ''effacement des anciennes données
dl = o1.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A) de l'onglet o1
Set pl = o1.Range("A1:L" & dl) 'définit la plage pl
For x = 1 To 9 'boucle sur le 9 critères
    o1.Range("A1").AutoFilter 'filte automatique activé
    o1.Range("A1").AutoFilter field:=x + 3, Criteria1:="x" '1 filtre sur le critère (x)
    o1.Range("A1").AutoFilter field:=3, Criteria1:="OUI" 'second filtre sur le matériel (OUI)
    o1.Range("A1").AutoFilter field:=2, Criteria1:="x" 'troisième filtre sur présent dans l'entreprise (OUI)
    If pl.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then 'condition : si le nombre de lignes visibles de pl est supérieur à 2
        'définit la cellule de destination dest (A1, ai A1 est vide, sinon la seconde cellule vide rencontrée dans la colonne A de f2
        Set dest = IIf(o2.Range("A1").Value = "", o2.Range("A1"), o2.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0))
        pl.SpecialCells(xlCellTypeVisible).Copy dest 'copie la plage pl et la colle dans dest
        dest.Value = "LISTE des POSTE " & x 'Ajoute le critère à l étiquette
    End If 'fin de la condition
    o1.Range("B6").AutoFilter 'filtre automatique désactivé
Next x 'prochain critère de la boucle
Application.ScreenUpdating = False 'affiche les changements à l'écran
End Sub
Il te faudra adapter les noms des onglet et les colonnes des plages. Dans l'exemple le tableau commence en A1.

Le code pour le bouton Récup. :
Code:
Sub Macro2()
Dim tos(2) As Object 'déclare le tableau de deux variables to (Tableau des OngletS)
Dim pad As Range 'déclare la variable pad (Plage Anciennes Données)
Dim i As Byte 'déclare la variable i (Incrément)
Dim dl As Integer 'déclare la variable dl
Dim pl As Range 'déclare la variable pl
Dim cel As Range 'déclare la variable cel (CELlule)
Dim pli As Range 'déclare la variable pli (Plage de LIgne)
Dim dest As Range 'déclare la variable dest (cellulke de DESTination)

Set tos(0) = Sheets("VB01") 'définit la variable 0 du tableau tos
Set tos(1) = Sheets("HD01") 'définit la variable 1 du tableau tos
Set tos(2) = Sheets("Récup") 'définit la variabe 2 du tableau tos (tu adapteras à ton cas)
'effacement des anciennes données
If tos(2).Range("A2").Value <> "" Then 'condition : si la cellule A2 de l'onglet "Récup" n'est pas vide
    Set pad = tos(2).Range("A1").CurrentRegion 'définit la plage pad des anciennes données
    Set pad = pad.Offset(1, 0).Resize(pad.Rows.Count - 1, pad.Columns.Count) 'redoefinit la plage pad (sans la première ligne)
    pad.Clear 'supprime tout dans la plage pad
End If 'fin de la condition
'récupérations des nouvelles données
For i = 0 To 1 'boucle 1 : sur les deux premiers onglets
    With tos(i) 'prend en compte l'onglet de la boucle
        dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne A (=1) de l'onglet BV01
        Set pl = .Range("A2:A" & dl) 'définit la plage pl
        For Each cel In pl 'boucle 2 : sur toutes les cellules cel de la plage pl
            Set pli = Application.Union(cel, cel.Offset(0, 1), cel.Offset(0, 3), cel.Offset(0, 5))
            Set dest = tos(2).Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
            pli.Copy dest
        Next cel
    End With
Next i
End Sub
Idem, à adapter...

Le fichier :
 

Pièces jointes

  • Écosphère_V01.xls
    54 KB · Affichages: 75

ecosphere

XLDnaute Nouveau
Re : Trier sur des bases de données avec conditions

Bonjour Robert

Merci de ce super code en VBA.
Ne connaissant pas je suis toujours impressionné et surtout par la démarche de réflexion qui permet d'écrire tout ça.
Comme je suis sur Smartphone je ne peux pas teste le code mais je le fais demain et je te tiens au courant bien sur.
Au fait c'est combien d'année de programmation VBA pour savoir ça ?

Encore Merci

Ecosphere.
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Trier sur des bases de données avec conditions

Bonjour Écosphère, bonjour le forum,

Ben comme je n'ai qu'un seul neurone il m'a fallu 792 années mais des gens nornaux y arrivent en quelques mois...
 

Discussions similaires

Réponses
8
Affichages
148

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16