[XL-2003] Assemblage de fichier dans le cadre d'une enquête [Résolu]

[ratm13]

Bonjour à tous,

Dans le cadre de mes études j’ai réalisé un questionnaire sous excel auprès de 200 personnes.

Chaque personne m’a envoyé par mail, son questionnaire dûment complété.

Je possède donc 200 questionnaires en .xls que je dois à présent traiter.

L’objectif est de pouvoir rassembler tous ces fichiers afin d’obtenir un fichier importable sous SAS.

Dans ce fichier, sera rassemblé en ligne les individus et en colonne les variables.

Ne maîtrisant pas les macros sous excel (ni sous SAS !), connaissez-vous des programmes exécutant ce laborieux travail ?!

Je sais lire et utiliser des macros VBA, mais de la à pouvoir en créer….

Merci pour votre précieuse aide !

Bonne soirée…

Ratm13.

[ZebreLoup]

Je ne pense pas qu'il puisse y avoir ce genre de programme, enfin surtout à posteriori. Ça doit surement exister mais il doit falloir formater le questionnaire avec le programme en question pour qu'il puisse l'exploiter.

Le plus simple est sûrement un petit peu de VBA. Mais si tu veux de l'aide il faudrait préciser un peu plus comment se présentent les fichiers de questionnaire et quel doit être le format du fichier pour SAS.

[ratm13]

Merci pour ta réponse.

Voici la structure de mon questionnaire:

Sexe =
Age =
Ville =



Combien de personnes connaissez-vous en = Bac+1 Bac+2 Bac+3 Bac+4

Les personnes indiquent le nombre en dessous de chaque modalité.

J'aimerais obtenir un fichier regroupant tous les questionnaires en un fichier sous cette forme:

Individus Sexe Age Ville Bac+1 Bac+2 Bac+3 Bac+4

1 H 18 Rennes 0 8 2 6
2 F 17 vannes 1 0 3 9

Sous format excel pour l'importation sous SAS c'est parfait ! du moment que le fichier soit sous la forme ligne/colonne.

[ZebreLoup]

Voici un bout de code à adapter avec le nom des feuilles, les bonnes cellules...
Il faut que Microsoft Scripting Runtime soit coché dans les références VBA.

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Option Explicit
 
Public Sub TraiterTousLesFichiers()
    Dim fd As FileDialog
    Dim folderName As String
    Dim fso As FileSystemObject
    Dim fld As Folder
    Dim f As File
    Dim wbk As Workbook
    Dim fichierOuvert As Boolean
    Dim ligneClasseur As Integer
 
    'On récupère le répertoire où sont stockés tous les fichiers
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.AllowMultiSelect = False
 
    If fd.Show = -1 Then
        folderName = fd.SelectedItems(1)
    End If
 
    'On boucle sur les classeurs
    Set fso = New FileSystemObject
    Set fld = fso.GetFolder(folderName)
 
    ligneClasseur = 2
 
    For Each f In fld.Files
        'On essaie d'ouvrir le fichier et on ne continue qu'en cas de réussite
        On Error Resume Next
        Set wbk = Workbooks.Open(f.Path)
        If Err.Number = 0 Then fichierOuvert = True Else fichierOuvert = False
        On Error GoTo 0
 
        If fichierOuvert Then
            On Error Resume Next 'Au cas où un des fichiers ne serait pas un questionnaire et que ça plante
            TraiterUnFichier wbk, ligneClasseur
            If Err.Number = 0 Then ligneClasseur = ligneClasseur + 1
            On Error GoTo 0
 
            wbk.Close
        End If
    Next f
 
End Sub
 
Private Sub TraiterUnFichier(wbk As Workbook, ligne As Integer)
    Dim ws As Worksheet
    Dim sexe, ville As String
    Dim age, bac1, bac2, bac3, bac4 As Integer
 
    Set ws = wbk.Worksheets("NomFeuille") 'Le nom de la feuille des tes questionnaires
 
    sexe = ws.Range("A1").Value 'Mettre la bonne cellule ici
    age = ws.Range("A2").Value 'Mettre la bonne cellule ici
    ville = ws.Range("A3").Value 'Mettre la bonne cellule ici
    bac1 = ws.Range("A4").Value 'Mettre la bonne cellule ici
    bac2 = ws.Range("A5").Value 'Mettre la bonne cellule ici
    bac3 = ws.Range("A6").Value 'Mettre la bonne cellule ici
    bac4 = ws.Range("A7").Value 'Mettre la bonne cellule ici
 
    Set ws = ThisWorkbook.Worksheets("NomFeuille") 'Le nom de la feuille dans laquelle tu copies les résultats
 
    ws.Cells(ligne, "A").Value = ligne - 1 'On part de la 2ème ligne car ligne de titre
    ws.Cells(ligne, "B").Value = sexe
    ws.Cells(ligne, "C").Value = age
    ws.Cells(ligne, "D").Value = ville
    ws.Cells(ligne, "E").Value = bac1
    ws.Cells(ligne, "F").Value = bac2
    ws.Cells(ligne, "G").Value = bac3
    ws.Cells(ligne, "H").Value = bac4
 
End Sub

[ratm13]

Merci !

J'ai une question, après avoir complété le programme, je le lance mais il ne trouve pas les fichiers dans le dossier.

Dois-je modifier ces lignes?

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
'On récupère le répertoire où sont stockés tous les fichiers
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.AllowMultiSelect = False
 
If fd.Show = -1 Then
folderName = fd.SelectedItems(1)
End If
 
'On boucle sur les classeurs
Set fso = New FileSystemObject
Set fld = fso.GetFolder(folderName)
 
ligneClasseur = 2
 
For Each f In fld.Files
'On essaie d'ouvrir le fichier et on ne continue qu'en cas de réussite
On Error Resume Next
Set wbk = Workbooks.Open(f.Path)
If Err.Number = 0 Then fichierOuvert = True Else fichierOuvert = False
On Error GoTo 0
 
If fichierOuvert Then
On Error Resume Next 'Au cas où un des fichiers ne serait pas un questionnaire et que ça plante
TraiterUnFichier wbk, ligneClasseur
If Err.Number = 0 Then ligneClasseur = ligneClasseur + 1
On Error GoTo 0
 
wbk.Close
End If
Next f
 
End Sub

[ratm13]

Ok, cela fonctionne désolé !

Je te remercie beaucoup pour ton aide ! C'était exactement ma demande !!

Bonne journée