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

[Marc-L]

Bonjour.

Il y aurait plus de réponse en postant dans la bonne section Macros & VBA Excel …

-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)

Comme c'est exprimé, ce que tu veux correspond déjà à la 2ème fonction ‼

Sinon sans présentation claire & exhaustive …

[gibba88]

Merci pour votre réponse , En faite comme je vous l'ai déja précisé , la 1ere fonction fais le travail que j'attends mais elle le fait seulement avec un seul fichier sélection .
Ce que je voudrais c'est une fonction qui me permettrait d'acceder aux fichiers avec une sélection multiples et de recupérerles les élements correspondants à la partie "ME" comme dans la fonction 1.En concaténant les données des fichiers les une aprés les autres.

NB: Contrairement à la 1ere, La 2eme fonction ne me permet pas de manupuler les fichiers

[Marc-L]

Et pourtant la première fonction est déjà en multi-sélection ‼

Juste le traitement manquant au sein de la boucle For Each … Next des lignes n°20 à 24 …

[gibba88]

En faite quand j'éxécute "Qstat()" ,en choisissant un seul fichier on ne note pas d'erreurs mais dès l'instant qu'on choisit plusieurs fichiers à extraire, il nous met "Erreur d'acces au fichier" .Donc le probleme vient du nombre de fichiers à choisir. J'ai essayer de déclarer un tableau et de parcourir les fichiers en les ouvrant un par un mais il m'affiche toujour le meme probleme .

NB: je suis débutant en VBA

[Marc-L]

Dans la continuité de ma précédente remarque, la ligne n°33 de la Fonction1 est inutile
car chaque fichier du tableau est initialisé en ligne n°20.

Tout le traitement doit donc se situer entre les lignes n°20 & 24
en utilisant la variable de la ligne n°20 pour l'accès à chacun des fichiers sélectionnés …