Discussion :

[Vincent32]

Bonjour à tous,

Je cherche à importer des données contenues dans plusieurs fichiers textes (eux même stockés dans un même répertoire).

Bien que j'ai consulté votre forum pendant plusieurs heures je suis toujours dans une impasse c'est pourquoi je sollicite votre aide

Voici la composition d'un fichier texte :

ssq = 0.157179E-004

Caracteristiques des pics
=========================
pic fonction position pic hauteur pic surface du pic 1/2 largeur mi-hauteur gauche 1/2 largeur mi-hauteur droite
1 pseudo-Voigt 0.20740000E+004 0.835427E-002 0.654465E+000 0.249361E+002 0.249361E+002
2 pseudo-Voigt 0.20910000E+004 0.409984E-002 0.722103E-001 0.827314E+001 0.827314E+001
3 pseudo-Voigt 0.21140000E+004 0.257435E-001 0.793274E+000 0.134689E+002 0.134689E+002
4 pseudo-Voigt 0.21390000E+004 0.605833E-002 0.125051E+000 0.969553E+001 0.969553E+001
5 pseudo-Voigt 0.21557812E+004 0.404550E-003 0.319314E-002 0.370752E+001 0.370752E+001
6 pseudo-Voigt 0.22071434E+004 0.293410E-004 0.956804E-006 0.153174E-001 0.153174E-001



Parametres des fonctions-pics
=============================
Pic numero 1
------------
Fonction :

...

Je voudrais extraire seulement cette partie de mes fichiers textes :

1 pseudo-Voigt 0.20740000E+004 0.835427E-002 0.654465E+000 0.249361E+002 0.249361E+002
2 pseudo-Voigt 0.20910000E+004 0.409984E-002 0.722103E-001 0.827314E+001 0.827314E+001
3 pseudo-Voigt 0.21140000E+004 0.257435E-001 0.793274E+000 0.134689E+002 0.134689E+002
4 pseudo-Voigt 0.21390000E+004 0.605833E-002 0.125051E+000 0.969553E+001 0.969553E+001
5 pseudo-Voigt 0.21557812E+004 0.404550E-003 0.319314E-002 0.370752E+001 0.370752E+001
6 pseudo-Voigt 0.22071434E+004 0.293410E-004 0.956804E-006 0.153174E-001 0.153174E-001

(en fait de la ligne 6 à la première ligne vide (ou saut de ligne))

J'ai déjà écris un bout de code :

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
Dim Chemin As String
    Dim Fso As Object
    Dim FsoRepertoire As Object
    Dim FsoFichier As Object
    Dim i As Long
    Dim c As Integer
    Dim strLigne As String
    Dim str() As String
 
    Chemin = Application.InputBox(prompt:="Indiquer le chemin du répertoire contenant les fichiers à importer", Type:=2)
 
    Worksheets("Feuil1").Range("A:IV").ClearContents 'suppression des données contenues dans les feuilles
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set FsoRepertoire = Fso.GetFolder(Chemin)
 
    'Boucle sur fichiers du repertoire
    i = 1
 
    For Each FsoFichier In FsoRepertoire.Files
        'ouvre le fichier
        Open FsoFichier.Path For Input As #1
        'Boucle sur chaque ligne du fichier
            Do While Not EOF(1)
                Line Input #1, strLigne
                'insere la ligne dans la cellule
                Cells(i, 1).Value = strLigne
                i = i + 1
            Loop
        Close #1
    Next

Cependant je n'arrive pas à comprendre comment lui dire d'importer à partir de la ligne 6 jusqu'à la première ligne vide ?

Votre aide est la bienvenue,

Merci d'avance

[78chris]

Bonjour

En testant la longueur de strLigne et en quittant la boucle par exit for...

[Marc-L]

Bonjour.

Oui, ou en testant si la ligne contient "pseudo-Voigt" via la fonction InStr par exemple

Sinon il y a une méthode plus rapide pour lire un fichier texte, c'est de le lire en une seule fois dans une variable … (à voir dans un second temps)

[Vincent32]

Ok merci pour ton aide. J'ai donc rajouté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
If strLigne >= 6 Then
blablabla
end If

Par contre pour tester si la ligne est vide je ne comprends pas ton exit for

En tout cas merci pour ton aide

[Vincent32]

ou en testant si la ligne contient "pseudo-Voigt"

Non c'est pas possible dans mon cas car ce mot revient à différents endroit dans le fichier txt

C'était néanmoins une bonne idée

[Vincent32]

Bon j'y suis arrivé ce n'est peut être pas l'ideal mais ça a le mérite de fonctionner :

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
Sub macro()
 
    Dim Chemin As String
    Dim Fso As Object
    Dim FsoRepertoire As Object
    Dim FsoFichier As Object
    Dim i As Long
    Dim c As Integer
    Dim strLigne As String
    Dim str() As String
    Dim j As Long
 
 
 
    Worksheets("Feuil1").Range("A:IV").ClearContents 'suppression des données contenues dans les feuilles
    Worksheets("Feuil1").Range("A:IV").ColumnWidth = 10.71
 
    Chemin = Application.InputBox(prompt:="Indiquer le chemin du répertoire contenant les fichiers à importer", Type:=2)
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set FsoRepertoire = Fso.GetFolder(Chemin)
 
    'Boucle sur fichiers du repertoire
    Cells(1, 1) = "Pic"
    Cells(1, 2) = "Fonction"
    Cells(1, 3) = "Position du pic"
    Cells(1, 4) = "Hauteur du pic"
    Cells(1, 5) = "Surface du pic"
    Cells(1, 6) = "1/2 largeur à mi hauteur du pic (gauche)"
    Cells(1, 7) = "1/2 largeur à mi hauteur du pic (droite)"
    Cells(1, 8) = "Largeur à mi hauteur du pic"
 
    i = 2
 
    For Each FsoFichier In FsoRepertoire.Files
        'ouvre le fichier
        j = 0
        Open FsoFichier.Path For Input As #1
        'Boucle sur chaque ligne du fichier
            Do While Not EOF(1)
            Line Input #1, strLigne
            j = j + 1
                If j > 5 Then
                    If strLigne = " " Then
                        i = i + 1
                    GoTo ferme
                    End If
                        str = Split(strLigne, Chr(9))
                        Cells(i, 1).Value = str(0)
                        Cells(i, 2).Value = str(1)
                        Cells(i, 3).Value = str(2)
                        Cells(i, 4).Value = str(3)
                        Cells(i, 5).Value = str(4)
                        Cells(i, 6).Value = str(5)
                        Cells(i, 7).Value = str(6)
                        Cells(i, 8) = Cells(i, 6) + Cells(i, 7)
                        i = i + 1
               End If
            Loop
ferme:
            Close #1
            Cells(i - 1, 4) = "Aire sulfure"
            Cells(i - 1, 5) = Cells(i - 7, 5) + Cells(i - 6, 5) + Cells(i - 5, 5)
        Next
    Worksheets("Feuil1").Range("A:IV").NumberFormat = "General"
    Worksheets("Feuil1").Range("A:IV").EntireColumn.AutoFit
End Sub

[Marc-L]

Mieux vaut éviter les GoTo, cela fait vieux BASIC d'avant la naissance de Windows et de Lisa, l'ancêtre du Mac ‼ Un Exit Do est tout à fait adapté.

Je préfère utilser la fonction Dir interne au VBA pour les fichiers car FSO n'est pas toujours bien rapide (plus il y a de fichiers) …

Sinon s'il n'y a pas trop de fichiers ni de lignes à traiter, cela va encore …