Questionnaire de satisfaction VBA

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,
j'ai un petit souci sur un code VBA. Suis entrain de réaliser un questionnaire de satisfaction pour le secteur de la santé. Je souhaiterai en fonction des résultats individuels concevoir une base de données. Suis bloqué sur un code qui me permet de déverser automatiquement le résultat d'enquête en fonction du N° de la personne interviewée dans la feuille "B1" via la feuille "R1".
Le questionnaire s'effectue avec la feuille "Q1" et la feuille "R1" sert de tampon pour le déversement dans la base de données "B1"
Le N° de la personne interviewé apparait dans les 03 feuilles.
dans la feuille "B1" nous avons de 1 à 100.
Voici le code que j'utilise :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub Base() Dim m As String Sheets("R1").Select m = Cells(1, 5).Value Sheets("B1").Select Rows("1:1").Select Selection.Find(what:=m, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate Sheets("R1").Select Range("E2:E75").Select Selection.COPY Sheets("B1").Select ActiveCell.Value() = m ActiveCell.Offset(0, 0).Select ActiveCell.Offset(1, 0).Select Selection.PasteSpecial Application.CutCopyMode = False End Sub
Au fait je voudrai en fonction du résultat de la recherche dans la feuille "B1" du N° de la personne interviewé sélection la colonne dont l'entête contient le même N° et y copier les résultats de l'enquête (de la personne concernée).
Merci

06/09/2010, 07h47
PPz78

Bonjour,

Etrange, je n'ai pas trouvé de code dans ton fichier Excel :cry:

Plus précisément qu'est ce qui ne fonctionne pas?

Il est même inutile de faire une recherche, vu la façon de ranger les réponses c'est mathématique :
questionnaire 1 rangé dans colonne 5
questionnaire 2 rangé dans colonne 7
questionnaire 3 rangé dans colonne 9
.......
questionnaire n rangé dans colonne 2*n+3

PPz
06/09/2010, 11h26
Gorfael

Salut MCMAL et le forum
Bienvenue ! La diplomatie n'étant pas mon fort, j'espère ne pas gâcher ton impression sur le site.

Le but de la feuille "R1" ?
Tu as des formules du type =si(esterreur(formule);"";formule) : ça c'est super, pour éviter d'avoir un message d'erreur sous les yeux. Mais là, tu fais un questionnaire (si j'ai bien compris ^^), et ta feuille est invisible, et le risque d'erreur détectable par excel nul => À quoi ça sert ? De plus, si le client ne remplit pas, perso, je préfère le distinguer d'une erreur.
Au lieu de se créer des noeuds aux boyaux de la tête sur cette feuille, assures-toi que les réponses données sont pertinentes.

Feuille "Q1"
Sexe => pourquoi ne pas mettre une liste de validation ? Ça évitera les F, Fem, 30cm, etc…
Les questions à partir de la 6 : en général deux ou trois cases possibles.
- Je réponds comment ? Une lettre ? Un chiffre ?
- 3 propositions (bon, assez bon, mauvais) : je réponds "X" dans les trois, comment tu l’exploites ?
On va arrêter là, c’est pas moi qui m’occupe du fichier

La macro donnée :
Dim m as string
Dim Cel as range

Sheets("R1").Select
m = Cells(1, 5).Value
Tu ralentis ton code, tu es obligé de l’écrire sur un module général
m = Sheets("R1").Cells(1, "E")

Sheets("B1").Select
Rows("1:1").Select
Selection.Find(what:=m, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Même remarque que précédemment. Ne connaissant pas tes besoins, juste une réflexion :
LookAt :=xlPart : une partie du texte => comment être sûr que 2 ne tombera pas sur 12 ou 20 ?
Set Cel = Sheets("B1").Rows(1).Find(what:=m, LookAt :=xlWhole)

Sheets("R1").Select
Range("E2:E75").Select
Selection.COPY
Même remarque
Sheets("R1").Range("E2:E75").COPY mais je la reprends plus loin

Sheets("B1").Select
Sélectionner la feuille B1
ActiveCell.Value() = m
Cellule active = m => on écrase le contenu de la cellule et on le remplace par m
ActiveCell.Offset(0, 0).Select
On sélectionne la cellule à 0 ligne, 0 colonne de la cellule active ???
ActiveCell.Offset(1, 0).Select
On sélectionne la cellule à 1 ligne et 0 colonne de la cellule active
Selection.PasteSpecial
Faire un coller sur la cellule active, tout format, toutes données
Sheets("R1").Range("E2:E75").COPY cel.offset(1,0)

Application.CutCopyMode = False
Enlever les tirets du mode copier/coller
End Sub

En régle générale, un questionnaire et une base de donnée ne sont pas structurés de manière identique : pour le formulaire (feuille "Q1") on dira que ça va (chacun a sa propre vision des choses)
Feuille base de donnée ("B1") :
Le but n'est pas de pouvoir visualiser, mais de travailler avec (statistiques, graphiques, etc...)
Qu'elle soit le plus compacte possible (une cellule par info pertinente) et qu'elle puisse recevoir un nombre "infini" de données.

C'est pour cela qu'elles se ressemblent toutes : les données(questions) sont en colonnes (champs) et les réponses (valeurs) sont en lignes. Une ligne, contenant toutes les réponses d'un client forme un enregistrement. avec pour clé d'identification le numéro du patient.

Chaque nouveau questionnaire d'un patient écrasant ses anciennes réponses, ou avec un identifiant contenant 2 champs ou plus (par exemple numPatient+date). le but étant qu'un enregistrement soit identifiable de manière unique : si tu as 2 clients, un satisfait et l'autre pas du tout, si tu enregistres 19 fois le premier et une fois le second, les moyennes ne réflèteront pas le 50%. Sur 10000, tu peux fausser tes résultats, mais pas de manière aussi visible.

Sur le questionnaire, tu peux avoir Oui/Non, Bon/Assez bon/Médiocre, mais sur ta base de donnée, tu n'auras que 2 colonnes, une pour chaque info => ça implique qu'on ne peut cocher qu'une réponse à une question.
A+

Bonjour Gorfael et merci pour la réponse
Je m'explique
Pour chaque question si la réponse est "OUI" on met un "R" (en format Wingdings 2) avec une seule réponse possible. Les réponses possibles restantes on laisse la cellule vide. (la réponse à la question est saisie dans la cellule coloriée en bordure rouge).

un Exemple :
4. Par qui avez-vous été référé ?

- Par une structure publique de santé (R avec format Wingdings 2)

- Par un médecin privé (on laisse la cellule vide)

Maintenant ce que je souhaite c'est de remplir la base de données au fur et à mesure des résultats des personnes interviewé (1 à 100) en fonction de la clé constituant le numéro d'identification.

Je reprend le code utilisé :
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 27 28 29 30 31 32 33 34 Sub Base() Dim m As String 'm = numéro d'identifiant de la personne interviewé présent dans la feuille "R1" en fonction du numéro saisi et dans la feuille "B1" de 1 à 100 pour le rechargement de la base de données. Sheets("R1").Select 'Sélectionne la feuille "R1" m = Cells(1, 5).Value 'Sélectionne la colonne la cellule "E1" de la feuille "R1" Sheets("B1").Select 'Sélectionne la feuille "B1" Rows("1:1").Select Selection.Find(what:=m, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate 'Recherche la variable m dans la feuille "B1" Sheets("R1").Select '"Sélectionne la feuille "R1" Range("E2:E75").Select 'Sélectionne les éléments à copier dans la feuille "B1" correspondant au meme N° d'identification de la personne interviewé. Par exemple si la personne interviewé on lui affecte le N°10 je souhaite à la fin que le résultat d'enquête soit copier dans la feuille "B1" précisément dans la colonne de la cellule où on a le N°10. (pas dans la 10ième colonne). Selection.COPY Sheets("B1").Select Rows("1:1").Select Selection.Find(what:=m, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate ActiveCell(m).Select 'c'est la où le code ne fonctionne pas. Le but est d'identifier le N° clé dans la feuille "B1", de sélectionner la colonne ayant comme enquéte le même N° puis de copier les données. ActiveCell.Offset(0, 0).Select 'Identification de la colonne ActiveCell.Offset(1, 0).Select 'Puis décaler d'une ligne afin d'éviter de copier sur l'entête du tableau comportant les N° d'identification Selection.PasteSpecial 'Copier collage spéciale valeur Application.CutCopyMode = False End Sub
Bonjour PPz78 et merci pour ta réponse

C'est ce code qui ne fonctionne pas
ActiveCell(m).Select
c'est la où le code ne fonctionne pas. Le but est d'identifier le N° clé dans la feuille "B1", de sélectionner la colonne ayant le même N° puis de copier les données dans cette colonne tout en décalant la copie d'une ligne.

Salut MCMAL et le forum
Je viens de me faire "rappeler à l'ordre" par un modérateur : pour le code, il vaut mieux utiliser les bailses prévues à cet effet. Le site ne s'en porte que mieux.

Citation:

C'est ce code qui ne fonctionne pas
ActiveCell(m).Select

Pas étonnant, vu que pour moi, ça ne veut rien dire non plus.
Ta macro commentée :

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub Base()
Dim m As String
'Moi, je mettrais Dim M as Integer : les valeurs que tu vas comparer à M sont des nombres de 1 à 100
Sheets("R1").Select
'Sélectionne la feuille "R1"
m = Cells(1, 5).Value
'Sélectionne la colonne la cellule "E1" de la feuille "R1" => faux
'défini la valeur de la variable m comme étant le texte de la cellule E1
'On peut l'ecrire plus simplement comme ceci
'm = Sheets("R1").Cells(1, 5)
'm est égal au texte de la cellule E1 de la feuille "B1".
'Comme normalement c'est un nombre, perso, je définirais m en integer
Sheets("B1").Select
'Sélectionne la feuille "B1"
Rows("1:1").Select
Selection.Find(what:=m, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'Recherche la variable m dans la feuille "B1" => faux
'recherche de la valeur de m n'importe où dans les cellules de la ligne 1 de la feuille "B1"
'=> tu recherches du texte (m défini en string) et la ligne 1 ne contient que des nombres :
'c'est comme si pour m égal 2 tu recherchais "2" => il n'y aura jamais égalité pour excel.
'Tu dois définir m comme étant un chiffre (integer ou long) ou définir les cellules de la ligne comme
'étant de format de cellule Texte.
Sheets("R1").Select
'Sélectionne la feuille "R1"
Range("E2:E75").Select
'Sélectionne les éléments à copier dans la feuille "B1" correspondant au meme N° d'identification
'de la personne interviewé. Par exemple si la personne interviewé on lui affecte le N°10 je souhaite
'à la fin que le résultat d'enquête soit copier dans la feuille "B1" précisément dans la colonne '
'de la cellule où on a le N°10. (pas dans la 10ième colonne).
Selection.Copy
'=> copie de la plage E2:E75 de la feuille R1 dans la mémoire
Sheets("B1").Select
Rows("1:1").Select
Selection.Find(what:=m, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'tu refais la même sélection qu'au début de la macro, alors que la sélection n'a pas changé sur B1
ActiveCell(m).Select
'c 'est la où le code ne fonctionne pas. Le but est d'identifier le N° clé dans la feuille "B1",
'de sélectionner la colonne ayant comme enquéte le même N° puis de copier les données.
'=> code erroné
ActiveCell.Offset(0, 0).Select
'Identification de la colonne
'Faux : on active la cellule active
ActiveCell.Offset(1, 0).Select
'Puis décaler d'une ligne afin d'éviter de copier sur l'entête du tableau
'comportant les N° d'identification
Selection.PasteSpecial
'Copier collage spéciale valeur => faux
'PasteSpecial sans argument, prend les arguments par défaut (copie tout)
Application.CutCopyMode = False
End Sub

Comme tu utlises des select/selection, tu dois obligatoirement mettre ton code dans un module général (non lié à une feuille).

Pour ce que j'en ai compris, une proposition, en fonction de ta macro :

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 Base()
'Déclaration ---------------------------------------------------
Dim Cel As Range    '=> cel est une plage de cellules
'Mise à l'état initial (MEI) -----------------------------------
Set Cel = Sheets("B1").Rows(1).Find(what:=Sheets("R1").Cells(1, "E"), LookAt:=xlWhole)
'Je fixe Cel comme étant la cellule de la 1re ligne de B1 qui est égale à tout le contenu de E1 de R1.
'Comme je n'ai pas défini de type, excel se débrouille
If Cel is nothing then 
'si Cesl est vide, alors
    Mgsbox "pas de correspondance de trouvée"
    'message d'alerte
    exit sub
    'sortir de la macro
end if
 
'Copie ---------------------------------------------------------
Sheets("R1").Range("E2:E75").Copy
'je stocke dans le presse-papier la plage E2:E75 de R1
Cel.Offset(1, 0).PasteSpecial (xlPasteValues)
'Je colle les valeurs du presse papier dans les cellules à partir de la ligne suivant Cel
'Remise en état ------------------------------------------------
Application.CutCopyMode = False
'efface les tirets du mode copier/coller
End Sub

Je ne l'ai pas testée, le code étant relativement simple.
A+

06/09/2010, 18h43
MCMAL

Bonjour Gorfael,
Vous êtes un génie.
C marche le code
merci encore

1 pièce(s) jointe(s)

Bonjour Gorfael,
J'ai un autre problème sur le même type de macro "Forum enquête satisfaction". Par rapport au fichier que j'avais joint au forum j'ai créé un autre onglet que j'ai nommé "S1" afin de récupérer les commentaires des personnes enquêtées.
J'ai un petit problème car le code bloque sur ce niveau :

Code:

ActiveCell.Offset(2, 1).Select

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 commentaires()
'Déclaration ---------------------------------------------------
Dim k As Range    '=> cel est une plage de cellules
'Mise à l'état initial (MEI) -----------------------------------
Set k = Sheets("S1").Columns(1).Find(what:=Sheets("R1").Cells(77, "A"), LookAt:=xlWhole)
'Je fixe k comme étant la cellule de la 1re ligne de B1 qui est égale à tout le contenu de E1 de R1.
'Comme je n'ai pas défini de type, excel se débrouille
'Copie ---------------------------------------------------------
If k Is Nothing Then
'si la cellule est vide, alors
    'message d'alerte
    Exit Sub
    'sortir de la macro
End If
Sheets("R1").Range("B78:E84").COPY
'je stocke dans le presse-papier la plage E2:E75 de R1
Sheets("S1").Select
 ActiveCell.Offset(2, 1).Select
'Je colle les valeurs du presse papier dans les cellules à partir de la ligne suivant Cel
'Remise en état ------------------------------------------------
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'efface les tirets du mode copier/coller
End Sub