Discussion :

[gibba88]

Bonjour;

Avant de vous poser mon problème , je tenais a vous remercier d'avance pour votre participation .

voici mon probleme:
Je dois réaliser des macros qui me permettraient d'extraire des données à partir des fichiers Qstat format text.

J'ai deux fonctions que je voulais adapter pour pouvoir faire l'extraction
(fonctions permettant d'acceder aux fichiers (sélections multiples) et d'afficher leurs données les unes aprés les autres sur une seule même feuille d'excel "concaténation des données").

-1ere fonction fait exactement le travail que je veux mais seulement avec un seul fichier séléctionné

-2eme fonction permet de faire une sélection de plusieurs fichiers et d'extraire leur données les unes aprés les autres (concaténation ) sur une même feuille excel

NB: Je veux adapter la 1ere fonctiona la deuxième (Faire plusieurs sélections de fichiers et de les afficher sur ine même feuille d'excel en les concaténant)

Fonction1

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
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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
 
'Fonction pour sélectionner le fichier Qstat à charger en Mémoire
Function select_fichier_Qstat() As String
'Déclaration des variables
Dim chemin As String
Dim intPosition As Integer
Dim strFichier As String
Dim msgErr As String
'variable pour contenir le chemin du fichier sélectionné.
Dim vrtSelectedItem As Variant
'variable objet FileDialog.
Dim fd As FileDialog
'Création d'un objet FileDialog comme une boîte de dialogue Fichier
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Use a With End With block to reference the FileDialog object
With fd
    'Utilisation de la méthode Show pour afficher la boîte de dialogue Fichier Picker et retourner l'action
    If .Show = -1 Then
        'pour parcourir les etapes
        For Each vrtSelectedItem In .SelectedItems
            'vrtSelectedItem pour stocker le chemin de chaque élément sélectionné
            'et affichage du chemin d'accès dans la boîte de message
            MsgBox "le fichier choisi est: " & vrtSelectedItem
        Next vrtSelectedItem
        If .SelectedItems.Count = 1 Then
           chemin = fd.SelectedItems(1)
        End If
    End If
End With
'sortir de l'objet.
Set fd = Nothing
'recupére le chemin
select_fichier_Qstat = chemin
'Pour recupérer le nom du fichier Qstat
' On cherche dans chemin la position du caractère \ en partant de la fin
intPosition = InStrRev(chemin, "\")
'si le caractère n'a pas été trouvé
If intPosition = 0 Then
    strFichier = chemin
'si le caractère a été trouvé : on prend tout ce qui le suit
Else
    strFichier = Mid(chemin, intPosition + 1)
    'Pour enlever l'extension, on cherche le dernier point
    intPosition = InStrRev(strFichier, ".")
    'Si on le trouve, on ne garde que ce qui précède
    If intPosition <> 0 Then
        strFichier = Mid(strFichier, 1, intPosition - 1)
    End If
End If
'on affiche le nom
'ActiveSheet.Cells(54, 3) = strFichier
End Function
 
 
Sub QStat()
    Dim num1 As Integer
    Dim nim2 As Integer
    Dim diff As Integer
    Dim intFic As Integer
    Dim strLigne As String
    Dim detect As Boolean
    Dim strCount As String
    Dim Source As String
 
    'affectation du repertoire
    Source = Module2.select_fichier_Qstat
    'detect : Variable de controle de fichier
    detect = True
    intFic = FreeFile
    'ouverture du fichier
    Open Source For Input As intFic
    While Not EOF(intFic) And detect
        detect = False
        Line Input #intFic, strLigne
        If Left(strLigne, 3) = "EV|" Then
            'Controle sur le Event
                'Nbre |
                num1 = Len(strLigne)
                strCount = Replace(strLigne, "|", "")
                num2 = Len(strCount)
                diff = num1 - num2
                If diff = 35 Then
                    detect = True
                Else
                    MsgBox "Erreur - Le champ EV contient " & diff & " | au lieu de 35"
                    detect = False
                End If
        End If
        If Left(strLigne, 3) = "ME|" Then
            'Controle sur la mesure
                'Nbre |
                num1 = Len(strLigne)
                strCount = Replace(strLigne, "|", "")
                num2 = Len(strCount)
                diff = num1 - num2
                If diff = 19 Then
                    detect = True
                Else
                    MsgBox "Erreur - Le champ ME contient " & diff & " | au lieu de 19"
                    detect = False
                End If
        End If
        If Left(strLigne, 3) = "TD|" Then
            'Controle sur les limites
                'Nbre |
                num1 = Len(strLigne)
                strCount = Replace(strLigne, "|", "")
                num2 = Len(strCount)
                diff = num1 - num2
                If diff = 18 Then
                    detect = True
                Else
                    MsgBox "Erreur - Le champ EV contient " & diff & " | au lieu de 18"
                    detect = False
                End If
        End If
    Wend
    If detect = False Then
        MsgBox "Erreur - Une ou plusieurs lignes sont erronnées"
    Else
        MsgBox "Le Fichier Qstat est correct !!"
    End If
    Close intFic
 
    ' On passe à l'affichage
    Dim i As Integer
    Dim cpt As Integer
    Dim Tableau() As String
    i = 1
    cpt = 1
 
    If detect = True Then
        intFic = FreeFile
        Worksheets("Feuil1").Select
        'Entete
        Cells(5, 1) = "Pas de Test"
        Cells(6, 1) = "Données Numérique"
 
        'ouverture du fichier
        Open Source For Input As intFic
        While Not EOF(intFic)
            Line Input #intFic, strLigne
            If Left(strLigne, 3) = "ME|" Then
                'on incrémente la ligne d'ecriture
                i = i + 1
                'on decompose
                Tableau = Split(strLigne, "|")
                'on ecrit
                 Cells(5, i) = Tableau(4)
                Cells(6, i) = Tableau(6)
            End If
        Wend
    End If
End Sub

Fonction 2

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
Sub Fonction_concatenee()
Dim Fichiers As Variant
Dim i As Integer
Dim wb As Workbook
Dim donnees As Range
 
    Fichiers = Application.GetOpenFilename("Fichiers dat (*.txt), *.txt", , , , True)
 
    If IsArray(Fichiers) = True Then
 
        Application.ScreenUpdating = False
 
        For i = LBound(Fichiers) To UBound(Fichiers)
 
            Workbooks.OpenText Filename:=Fichiers(i), DataType:=xlDelimited, Tab:=True
            Set wb = ActiveWorkbook
            Set donnees = wb.Sheets(1).[A1].CurrentRegion
            donnees.Copy ThisWorkbook.Sheets(1).[A65536].End(xlUp)(2)
            wb.Close
            Set donnees = Nothing
            Set wb = Nothing
 
        Next i
 
        Application.ScreenUpdating = True
 
    End If
End Sub

fichiers Qstat