Discussion :

[mandrake57]

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]

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]

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]

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]

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]

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: