Excel VBA Rechercher et Afficher les données

Version imprimable

22/07/2012, 17h16
Ricoeva84

Excel VBA Rechercher et Afficher les données

Bonjour,

Je cherche désespérément une solution sur vba par macro pour afficher des données selon plusieurs critères:
1/ J'ai dans une feuille un tableau (Sheets "BDD") en colonne les données pré-enregistrer dans ce tableau j'ai besoin d'afficher les données de la colonne Y:Y en fonction de plusieurs critères de la feuille ("FEuil1") positioné en range ("C2:C12") pour les codes produits / Range ("A1") pour un critère géographique/Range ("B2") pour la période.
2/ Ainsi la macro recherche les données de la ( Sheets("BDD")) en fonction des criètères de la ("Feuil1") & Range ("A1") & Range ("B2")
Soit dans la Sheets ("BDD") chaque critère de la feuil1 se retrouve dans l'ordre:
- Code produit Colonne A:A
- Géographie colonne B:B
- Période colonnne C:C
- Données que l'on veut afficher à côté de chaque code Produit, soit pour chaque code une valeur se trouve en colonne Y:Y
3/Afficher les données à coté de chaque code produit dans la feuil1 soit "D2:D12" et si pas de données trouvé, afficher 0

Je précise que j'ai essayé avec une formule matricielle index equiv avec concaténation et que cela marche très bien, mais c'est hyper lourd au niveau temps de chargement je préfèrerai en vba, d'où l'idée de faire appel à votre aide.

Merci beaucoup pour le coup de main, j'ai essayé différentes techniques mais je tourne beaucoup en rond...je ne trouve pas la solution sur les différents forum. Et comme ici j'avais déjà reçu une superbe aide!!!
Merci beaucoup
22/07/2012, 17h38
mercatog

Bonjour
Par vba, essaies par l'enregistreur de macro

Faire un filtre automatique selon tes critères
Copier les données visibles
Enlever le filtre automatique

Merci pour le conseil mais une boucle avec Find ?

Merci,

J'ai suivi votre conseil en utilisant l'enregistreur Macro, mais ça ne m'avance pas trop...
Voici où j'en sui à partir de plusieurs forum...:calim2:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub rechercherafficher()
 
Dim a as String
Dim b as String
Dim c as Range
Dim h as Range
 
a= Range ("A2") ' correspond au critère 1
b= Range ("B3") ' correspond au critère 2
c = Range ("C2:C12) ' correspond au critère Code produit où je vais affecter une boucle pour chaque ligne
 
For each cell in c
Nom= cell.Value
With Sheets ("BDD")
set h = .columns("A:A" & "C:C"& "M:M"&"Y:Y").Find (Nom)
' "A:A" correspond au code produit soit c/ C:C correspond au critère 1 période/ "M:M" correspond au criètre 2 géographie/ "Y:Y" à la donnée que l'on recherche soit "Nom= Cell.value) le fameux find (Nom)
if not h is nothing then
Sheets ("Feuil1"). range ("D" & cell.row).value = h.value
Else
MsgBox "Ligne pas encore crée)
End if
End with
next cell
End Sub

Le problème ici s'il y en a qu'un (...) c'est que je ne sais pas comment dans le code cumulé les différents critères....
merci encore pour le coup de main.
Ricoeva

22/07/2012, 18h23
mercatog

Quelle est ta version d'Excel?
Tu peux mettre en PJ un extrait de ton fichier (sans données confidentielles)
22/07/2012, 19h08
Ricoeva84

1 pièce(s) jointe(s)

Ci-joint le fichier en exemple

Merci encore pour le coup de main, je suis vraiment navré de demander de l'aide...mais je ne trouve pas la solution...
Au passage je n'ai pas réussi à mettre le fichier avec la macro sans passer par le fichier zip
merci beaucoup
J'ai excel 2010

ricoeva

En utilisant un filtre automatique

Code:

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
Sub Extraction()
Dim Ws As Worksheet
Dim LastLig As Long
Dim i As Byte
 
Application.ScreenUpdating = False
Set Ws = Worksheets("Feuil1")
With Worksheets("BDD")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    With .Range("A1:AF" & LastLig)
        .AutoFilter Field:=3, Criteria1:=Ws.Range("A2")
        .AutoFilter Field:=13, Criteria1:=Ws.Range("B2")
        For i = 3 To 13
            .AutoFilter Field:=1, Criteria1:=Ws.Range("C" & i)
            If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
                .Range("R2:AE" & LastLig).SpecialCells(xlCellTypeVisible).Copy Ws.Range("D" & i)
            Else
                Ws.Range("D" & i & ":Q" & i).ClearContents
            End If
        Next i
    End With
    .AutoFilterMode = False
End With
Set Ws = Nothing
End Sub

22/07/2012, 19h29
Ricoeva84

ok hyper rapide comme réponse je test...rien avoir avec ce que j'avais commencé à faire..

merci beaucoup
22/07/2012, 19h31
mercatog

J'ai édité le code en ajoutant la possibilité d'effacer les données existantes au cas de changement des critère.
22/07/2012, 22h27
Ricoeva84

1 pièce(s) jointe(s)

pas encore au point

Le fichier bug sur cette partie:

Code:

.AutoFilter Field:=3, Criteria1:=Ws.Range("A2")

j'avoue que comme c'est une méthode que je ne connais pas je vois pas pourquoi ça bug...
Le fichier avec le code tapé ci-joint.

Encore merci pour cette super réactivité un dimanche soir!!:calim2:
22/07/2012, 23h07
mercatog

Dans le code, tu as mis CriteriaL:=...
alors que c'est Criteria1 (Un)

Toujours n'oublies pas F1 (aide)

Citation:

Range.AutoFilter, méthode
Cette méthode filtre une liste à l'aide du filtre automatique. Syntaxe
expression.AutoFilter(Field, Criteria1, Operator, Criteria2, VisibleDropDown)
expression Expression qui renvoie un objet Range.
Paramètres
Nom Obligatoire/Facultatif Type de données Description Field Facultatif Variante Décalage de type entier du champ sur lequel le filtre sera basé (à partir de la gauche de la liste ; le champ situé le plus à gauche est le champ un). Criteria1 Facultatif Variante Critère (une chaîne ; par exemple, « 101 »). Utilisez « = » pour rechercher les champs vides ou « <> » pour rechercher les champs non vides. Si cet argument est ignoré, le critère est All. Si Opérateur est xlTop10Items, Critère1 spécifie le nombre d'éléments (par exemple, « 10 »). Operator Facultatif XlAutoFilterOperator Une des constantes de XlAutoFilterOperator spécifiant le type de filtre. Criteria2 Facultatif Variante Second critère (une chaîne). Utilisé avec Critère1 et Opérateur pour élaborer des critères composés. VisibleDropDown Facultatif Variante True pour afficher la flèche vers le bas AutoFilter pour le champ filtré. False pour masquer la flèche vers le bas AutoFilter pour le champ filtré. La valeur par défaut est True.
22/07/2012, 23h18
Ricoeva84

Bonsoir,

je viens de trouver le problème et ça marche. En fait j'ai tapé Criterial alors qu'il fallait tapper Criteria1 avec un 1 et non un l

Merci beaucoup ça marche à la perfection!!!!

Bonne soirée!!!

ricoeva

Merci Mercatog, tu as répondu avant que je m'en rende compte!!!

Bonne soirée encore
23/07/2012, 14h59
Ricoeva84

Extraction et Modification de la base de Donnée

Bonjour,

Je me demander si tu connaissais un moyen simple par vba une fois l'extraction des lignes faite (grâce à toi hier soir) sur la feuil1, d'écraser les données de la BDD une fois modofication faite dans la feuil1 suite à l'extraction.

Par Ecraser je veux dire copier les données de la feuil1 et de remplacer les données dans la BDD.

Est-ce que le vba filtre automatique marcherai dans l'autre sens ?

Merci
24/07/2012, 19h42
Ricoeva84

Mercatog tu n'as pas une idée pour la partie Modification?

Bonjour Mercatog,

Tu n'aurais pas une idée sur cette partie de là de modification d'enregistrement ?:calim2:
Ci-dessous le lien de ce nouveau tag crée:
http://www.developpez.net/forums/d12...-base-donnees/

Merci pour le coup de main
24/07/2012, 21h11
mercatog

Pourquoi ne pas filtrer et modifier sur place, c'est à dire directement sur ta base BDD sans passer par Feuil1
25/07/2012, 00h12
Ricoeva84

oui c'est sur...
L'idée c'est que j'essayer de faire une petite application pour l'équipe afin que tout le monde puisse par une interface et 2 boutons enregistrer/générer une extraction/ et la modifier sans toucher à la base de données et en plus personnellement m'améliorer en VBA (enfin j'essaye), j'apprend beaucoup avec les exemples.
25/07/2012, 00h17
mercatog

Du moment que tu pourras toucher au code produit qui devrait être une clé pour ta base, la mise à jour ou modification de ta base sera affectée et loin du résultat escompté.

Si par contre, tu ne touche pas aux codes produits, tu pourras toujours avoir une macro quasi identique qui fera le travail inverse.
25/07/2012, 07h55
Ricoeva84

Mes codes produits restent les mêmes, ils ne changent pas.
Ce que je veux dire c'est que j'ai au total 100 codes produits, le truc c'est que je ne les affiche pas tous en même temps pour la 1ère saisie, donc sur la feuil1 les 3 critères restent mobiles. C'est pour cela que la macro d'extraction que tu m'as fournis fonctionne à la perfection l'idée c'est de faire la même chose mais en sens inverse, ce n'est pas de changer les codes c'est de juste corriger les quantités sur la partie affichage, et de trouver un moyen que si sur la partie BDD les 3 critères rencontrer n'existent pas dans la BDD dans ce cas appeler ma macro enregistrement.

Si tu veux extraire des données vers la feuille Feuil1 selon la liste des codes produit, le mois et l'enseigne, nous avions ce code

Code:

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
Option Explicit
 
Sub Extraction()
Dim Ws As Worksheet
Dim LastLig As Long
Dim i As Byte
 
Application.ScreenUpdating = False
Set Ws = Worksheets("Feuil1")
With Worksheets("BDD")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("A1:AF" & LastLig).AutoFilter Field:=3, Criteria1:=Ws.Range("A2")
    .Range("A1:AF" & LastLig).AutoFilter Field:=13, Criteria1:=Ws.Range("B2")
    For i = 3 To 13
        .Range("A1:AF" & LastLig).AutoFilter Field:=1, Criteria1:=Ws.Range("C" & i)
        If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Range("R2:AE" & LastLig).SpecialCells(xlCellTypeVisible).Copy Ws.Range("D" & i)
        Else
            Ws.Range("D" & i & ":Q" & i).ClearContents
        End If
    Next i
    .AutoFilterMode = False
End With
Set Ws = Nothing
End Sub

Maintenant, si on modifie les données dans Feuil1 sans toucher aux critères codes produit, mois et enseigne

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Modification()
Dim Ws As Worksheet
Dim LastLig As Long
Dim i As Byte
 
Application.ScreenUpdating = False
Set Ws = Worksheets("Feuil1")
With Worksheets("BDD")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("A1:AF" & LastLig).AutoFilter Field:=3, Criteria1:=Ws.Range("A2")
    .Range("A1:AF" & LastLig).AutoFilter Field:=13, Criteria1:=Ws.Range("B2")
    For i = 3 To 13
        .Range("A1:AF" & LastLig).AutoFilter Field:=1, Criteria1:=Ws.Range("C" & i)
        If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
            Ws.Range("D" & i & ":Q" & i).Copy .Range("R2:R" & LastLig).SpecialCells(xlCellTypeVisible)
        End If
    Next i
    .AutoFilterMode = False
End With
Set Ws = Nothing
End Sub

25/07/2012, 18h35
Ricoeva84

Bonjour Mercatog! Merci beaucoup!
C'est exactement cela, je ne plaçait pas le copy au bon endroit. ça marche à la perfection.

L'idéal serait d'avoir un code qui détecte les lignes qui sont nouvelles pour enregistrer (donc insérer dans la base de donnée), et modifie celle qui existe déjà.

mais cela demande je suppose de fonctionne à la ligne et non par plage de donnée.

En tout cas c'est très bien ainsi! J'ai donc fait un onglet création (pour les nouveau) et onglet modification!

L'idée c'est que je trouve un moyen d'éviter les doublons sur cette partie création, peut être en utilisant ton modèle de code pour vérifier si les 3 criètres rencontrer n'existe pas et afficher un mxgbox qui dit "attention code existant vous ne pouvez pas enregistrer de doublon" et aller sur l'onglet modification.