Récupération des données dans une base à partir d'une valeur donnée

**mandrake57** · 23/03/2011, 22h22

Bonsoir à tous!

je suis confronté à point épineux pour un projet que j'essaye de faire avancer.

pour vous expliquer, j'ai un fichier Excel contenant deux feuilles (pour l'exemple). La première feuille est la feuille de base de données (elle contient tous les données) et la deuxième est une feuille qui sert de bulletin (pour un envoi ultérieur).

Le but de ce que je cherche à faire sans réussir est de remplir les champs du bulletin en fonction du numéro de demande qui sera saisie dans cette feuille.

comme vous le verrez dans le fichier d'exemple le bulletin est un bulletin d'analyse chimique. Le problème est que chaque demande ne se ressemble pas et je voudrais que dans le bulletin n'apparaisse que les échantillons concernés et surtout que les éléments concernés (qui doivent s'afficher pour l'en tête des éléments dans les cellules à droites des repères).

Les éléments non analysés ne doivant pas apparître dans le bulletin.

Je vous joins un fichier d'exemple (sommaire) pour que vous situez mieux le problème.

Merci!!!

**mayekeul** · 24/03/2011, 14h26

Bonjour,

tu pourrais proceder un peu comme cela je pense

(Code à coller dans l'événement change de la feuille "Feuil2")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
'Code à coller dans l'événement change de la feuille "Feuil2"
Dim R As Range
Dim C As Long, cr As Long
 
If Not Intersect(Target, [B1]) Is Nothing Then
    Sheet1.Range("A:L").AutoFilter field:=3, Criteria1:=Target.Value
 
    For Each R In Sheet1.Range("A2:A" & Sheet1.Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
        If R.Row = 1 Then Exit Sub
        For C = 1 To 10
            Sheet2.Range("B5") = R.Offset(0, 1)                 'Demandeur
            Sheet2.Range("B6") = R.Offset(0, 4)                 'Date emission
            Sheet2.Range("B7") = R.Offset(0, 3)                 'Compte
            Sheet2.Range("A11").Offset(cr, 0) = R.Offset(0, 5)  'Repere Laboratoire
            Sheet2.Range("B11").Offset(cr, 0) = R.Offset(0, 6)  'Repère Demandeur
            '...
        Next C
        cr = cr + 1
    Next R
End If

**mandrake57** · 24/03/2011, 16h15

J'ai mis le code dans le fichier que j'avais joint et j'obtiens une erreur d'exécution '424' "Objet requis"

J'ai modifier les "sheet" par des "worksheets" et ça fonctionne.

Par contre si je modifie la valeur de la demande cela ne me doone pas les infos correspondantes au nouveau numéro.

Et à partir de la cellule C11, y a t-il possibilités de faire apparaître les colonnes d'éléments concernées par un résultats?

Question subsidiaire peux-tu m'expliquer les mécanismes du code proposé?

Merci beaucoup pour l'aide

**mayekeul** · 25/03/2011, 07h54

bonjour,

Par contre si je modifie la valeur de la demande cela ne me doone pas les infos correspondantes au nouveau numéro.

et ça te donne quoi?

Et à partir de la cellule C11, y a t-il possibilités de faire apparaître les colonnes d'éléments concernées par un résultats?

peut-être que c'est à cause que c'est le matin mais je ne comprends pas très bien ce que tu veux dire exactement

Question subsidiaire peux-tu m'expliquer les mécanismes du code proposé?

ça je sais!

je remet donc le code avec des annotations ci-dessous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Dim R As Range
Dim C As Long, cr As Long
 
'on dis execute le code si la cellule qui est changée est la cellule "B2" 
If Not Intersect(Target, [B1]) Is Nothing Then
    'ici on met un filtre sur le tableau de la première feuille
    'le troisième champ doit etre égal à la valeur de la cellule "B2" 
    Sheet1.Range("A:L").AutoFilter field:=3, Criteria1:=Target.Value
    'ici on toute les cellules visible de la premère colonne sont balayées
    For Each R In Sheet1.Range("A2:A" & Sheet1.Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
        'si la première cellule trouvée est sur la première ligne c'est que le filtre ne renvoie aucune valeur et on sort de la procèdure
        If R.Row = 1 Then Exit Sub
        'ici on passe en revue les colonnes du tableau
        'et on les affecte au bon endroit
        'on prends pour référence R(la première cellule de la ligne) que l'on décale en fonction du besoin
            Sheet2.Range("B5") = R.Offset(0, 1)                 'Demandeur
            Sheet2.Range("B6") = R.Offset(0, 4)                 'Date emission
            Sheet2.Range("B7") = R.Offset(0, 3)                 'Compte
            Sheet2.Range("A11").Offset(cr, 0) = R.Offset(0, 5)  'Repere Laboratoire
            Sheet2.Range("B11").Offset(cr, 0) = R.Offset(0, 6)  'Repère Demandeur
            '...
        cr = cr + 1
    Next R
End If

Au passage j'ai sup^primé une boucle dont je me demande bien pourquoi je l'y avais mise....

**mandrake57** · 25/03/2011, 09h19

Pour la première partie, lorsque je rentre une valeur dans la cellule du numéro de demande j'obtiens les infos correspondantes. Mais si je modifies ce numéro en y inscrivant un autre numéro (présent dans la base) les infos ne se mettent pas à jour. Les infos sont "statiques" par rapport au premier numéro inscrit.

Pour la deuxième question, j'aimerais qu'à partir de la cellule C11 apparaissent les en-têtes (C, S, N, O, etc...) des éléments qui ont un résultat de mesure dans la base. Bien sur je voudrais faire apparaître dans les lignes du dessous les résultats aussi.

Le but et de ne pas avoir toute la liste des éléments sachant que certains n'ont pas de résultats.

Merci pour les commentaires sur le code je vais lire ça pour mieux le comprendre!!!!

Si tu as une idée sur les deux questions je suis preneur

Merci

**mayekeul** · 25/03/2011, 10h28

Pour la première partie, lorsque je rentre une valeur dans la cellule du numéro de demande j'obtiens les infos correspondantes. Mais si je modifies ce numéro en y inscrivant un autre numéro (présent dans la base) les infos ne se mettent pas à jour. Les infos sont "statiques" par rapport au premier numéro inscrit.

juste, il faudrait vider le tableau avant
j'en profite donc pour poster un corrigé du code précédemment posté.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
28
29
30
31
32
33
34
35
36
Dim R As Range, Rng As Range
Dim CR As Long
 
If Not Intersect(Target, [B1]) Is Nothing Then
    'appiquer le filtre sur la première feuille
    Sheets("Feuil1").Range("A:L").AutoFilter field:=3, Criteria1:=Target.Value
    'vider les données de la deuxième feuille
    Sheets("Feuil2").Range("B5:B7,A11:J1000").Clear
    'définir les donnée à transferer (sur base de la première colonne)
    Set Rng = Sheets("Feuil1").Cells(1, 1).CurrentRegion
    'si le filtre ne renvoie pas de valeur alors une erreur survient
    'ici on décide donc de sortir de la procedure si c'est le cas
    On Error GoTo EmptyFilter
        Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
    'remise à zero du gestionnaire d'erreur
    On Error GoTo 0
    'passons en revue les différentes données à tranferer
    For Each R In Rng
        'appliquons les données du tableau de la feuille 1 sur la feuille 2
        Sheets("Feuil2").Range("B5") = R.Offset(0, 1)                 'Demandeur
        Sheets("Feuil2").Range("B6") = R.Offset(0, 4)                 'Date emission
        Sheets("Feuil2").Range("B7") = R.Offset(0, 3)                 'Compte
        Sheets("Feuil2").Range("A11").Offset(CR, 0) = R.Offset(0, 5)  'Repere Laboratoire
        Sheets("Feuil2").Range("B11").Offset(CR, 0) = R.Offset(0, 6)  'Repère Demandeur
        Sheets("Feuil2").Range("C11").Offset(CR, 0) = R.Offset(0, 7)  'C
        Sheets("Feuil2").Range("D11").Offset(CR, 0) = R.Offset(0, 8)  'S
        Sheets("Feuil2").Range("E11").Offset(CR, 0) = R.Offset(0, 9)  'o
        Sheets("Feuil2").Range("F11").Offset(CR, 0) = R.Offset(0, 10) 'N
        Sheets("Feuil2").Range("G11").Offset(CR, 0) = R.Offset(0, 11) 'H
        'incrémentons l'offset de ligne
        CR = CR + 1
    Next R
End If
 
Exit Sub
EmptyFilter:

**mandrake57** · 25/03/2011, 13h48

Je viens d'essayer ta dernière proposition de code, ça marche pas mal.

Il reste juste un petit détail pour les éléments. Crois-tui qu'il faudrait masquer les colonnes n'ayant pas de résultats après le filtrage pour n'avoir que des collones avec résultats?

**mayekeul** · 25/03/2011, 13h51

ah moi je ne crois rien!

cela dépends de toi en fait. moi perso, je laisserai meême les colonnes vides mais bon

**mandrake57** · 25/03/2011, 14h06

Je comprends mais je dois faire apparaître juste les colonnes concernées par une analyse.

Pour le moment je le fais avec des formules dans chaque cases mais c'est une usine à gaz...

**mayekeul** · 25/03/2011, 14h48

comme ça??

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
28
29
30
31
32
33
34
35
36
37
38
39
Dim R As Range, Rng As Range
Dim CR As Integer, COL As Integer
If Not Intersect(Target, [B1]) Is Nothing Then
    'appiquer le filtre sur la première feuille
    Sheets("Feuil1").Range("A:L").AutoFilter field:=3, Criteria1:=Target.Value
    'vider les données de la deuxième feuille
    Sheets("Feuil2").Range("B5:B7,A11:J1000").Clear
    'définir les donnée à transferer (sur base de la première colonne)
    Set Rng = Sheets("Feuil1").Cells(1, 1).CurrentRegion
    'si le filtre ne renvoie pas de valeur alors une erreur survient
    'ici on décide donc de sortir de la procedure si c'est le cas
    On Error GoTo EmptyFilter
        Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
    'remise à zero du gestionnaire d'erreur
    On Error GoTo 0
    'passons en revue les différentes données à tranferer
    For Each R In Rng
        'appliquons les données du tableau de la feuille 1 sur la feuille 2
        Sheets("Feuil2").Range("B5") = R.Offset(0, 1)                 'Demandeur
        Sheets("Feuil2").Range("B6") = R.Offset(0, 4)                 'Date emission
        Sheets("Feuil2").Range("B7") = R.Offset(0, 3)                 'Compte
        Sheets("Feuil2").Range("A11").Offset(CR, 0) = R.Offset(0, 5)  'Repere Laboratoire
        Sheets("Feuil2").Range("B11").Offset(CR, 0) = R.Offset(0, 6)  'Repère Demandeur
        Sheets("Feuil2").Range("C11").Offset(CR, 0) = R.Offset(0, 7)  'C
        Sheets("Feuil2").Range("D11").Offset(CR, 0) = R.Offset(0, 8)  'S
        Sheets("Feuil2").Range("E11").Offset(CR, 0) = R.Offset(0, 9)  'o
        Sheets("Feuil2").Range("F11").Offset(CR, 0) = R.Offset(0, 10) 'N
        Sheets("Feuil2").Range("G11").Offset(CR, 0) = R.Offset(0, 11) 'H
        'incrémentons l'offset de ligne
        CR = CR + 1
    Next R
    'hide unwanted columns
    For COL = 3 To 7
        If Application.WorksheetFunction.Sum(Rng.Offset(0, COL + 4)) = 0 Then Columns(COL).EntireColumn.Hidden = True
    Next COL
End If
 
Exit Sub
EmptyFilter:

**mandrake57** · 25/03/2011, 15h24

C'est quasiment cela. Mais en fait il faut que j'affiches seulement les colonnes qui ont une analyse pour la demandé sélectionnée. Là ça affiche seulment la colonne de l'élément qui est analysé dans toutes les demandes.

**mayekeul** · 25/03/2011, 15h38

je ne comprends pas trop là lol
je dois être trop fatigué lol

**mandrake57** · 25/03/2011, 16h03

Envoyé par mayekeul

je ne comprends pas trop là lol
je dois être trop fatigué lol

du type si numéro de demande = 1

rep laboratoire rep demandeur C S
1 AA 1 3

si numero de demande = 2

rep laboratoire rep demandeur S N
2 AC 1 3
3 AZ 3 7

Désolé pour l'explication je ne peux pas fournir le fichier tel quel pour le moment (présence de noms, logos,etc...).

**mayekeul** · 28/03/2011, 07h51

bonjour,

euh comme ça??

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range, Rng As Range
Dim CR As Integer, COL As Integer
If Not Intersect(Target, [B1]) Is Nothing Then
    'appiquer le filtre sur la première feuille
    Sheets("Feuil1").Range("A:L").AutoFilter field:=3, Criteria1:=Target.Value
    'vider les données de la deuxième feuille
    Sheets("Feuil2").Range("B5:B7,A11:J1000").Clear
    'définir les donnée à transferer (sur base de la première colonne)
    Set Rng = Sheets("Feuil1").Cells(1, 1).CurrentRegion
    'si le filtre ne renvoie pas de valeur alors une erreur survient
    'ici on décide donc de sortir de la procedure si c'est le cas
    On Error GoTo EmptyFilter
        Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
    'remise à zero du gestionnaire d'erreur
    On Error GoTo 0
    'passons en revue les différentes données à tranferer
    For Each R In Rng
        'appliquons les données du tableau de la feuille 1 sur la feuille 2
        Sheets("Feuil2").Range("B5") = R.Offset(0, 1)                 'Demandeur
        Sheets("Feuil2").Range("B6") = R.Offset(0, 4)                 'Date emission
        Sheets("Feuil2").Range("B7") = R.Offset(0, 3)                 'Compte
        Sheets("Feuil2").Range("A11").Offset(CR, 0) = R.Offset(0, 5)  'Repere Laboratoire
        Sheets("Feuil2").Range("B11").Offset(CR, 0) = R.Offset(0, 6)  'Repère Demandeur
        Sheets("Feuil2").Range("C11").Offset(CR, 0) = R.Offset(0, 7)  'C
        Sheets("Feuil2").Range("D11").Offset(CR, 0) = R.Offset(0, 8)  'S
        Sheets("Feuil2").Range("E11").Offset(CR, 0) = R.Offset(0, 9)  'o
        Sheets("Feuil2").Range("F11").Offset(CR, 0) = R.Offset(0, 10) 'N
        Sheets("Feuil2").Range("G11").Offset(CR, 0) = R.Offset(0, 11) 'H
        'incrémentons l'offset de ligne
        CR = CR + 1
    Next R
    'hide unwanted columns
    Columns("C:H").Hidden = False
    For COL = 3 To 7
        If Application.WorksheetFunction.Sum(Rng.Offset(0, COL + 4)) = 0 Then Columns(COL).EntireColumn.Hidden = True
    Next COL
End If
 
Exit Sub
EmptyFilter:
End Sub

**mandrake57** · 28/03/2011, 22h03

Désolé pour la réponse tardive (je suis en plein travaux...).

Ca marche vraiment bien!

Allez pour fignoler le tout et avant que j’intègre ce code à mon fichier, j'aurais une dernière question.

Quel partie de code dois-je rajouter pour faire apparaître les en-têtes des éléments suivant ce qui s'affiche pour la demande choisie?

Avec cette dernière réponse je devrais pouvoir l'intégrer à mon fichier!

Merci pour ton aide

**mayekeul** · 29/03/2011, 08h37

bonjour,

dans ce programme, il n'y a pas vraiment de code pour les en-têtes de lignes
Ils sont censés etre codé "en dur" directement sur la feuille

je te joint un exemple de fichier

**mandrake57** · 29/03/2011, 10h56

Je regarderais ton code ce sœur en rentrant.

Par contre je ne pense pas qu'un codage en dur soit correct. En effet les en-têtes varient selon les demandes. Je pensais''il fallait procéder comme out les éléments.

Merci

**mandrake57** · 30/03/2011, 18h14

Bon j'ai regardais le code mais ça ne va pas.

J'ai donc un fichier qui pourrait te permettre de comprendre ce que j'aimerais faire en macro. il contient trois feuilles (Base, Bulletin, Calcul)..

Il ne faut pas faire attention au fichier c'est un brouillon. Il suffit de choisir une demande dans la feuille bulletin avec la liste déroukante et hop!

Merci pour l'aide