lire un fichier texte et extraire des données

Version imprimable

bonsoir
voila ou j'en suis

Code:

1
2
3
4
5
6
7
8
9
10
Private Sub CommandButton1_Click()
Open "c:\SR_6_8_4_GARANTI_5.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, textline
TextBox1.Text = TextBox1.Text & textline & vbCrLf
 
'MsgBox textline
Loop
Close #1
End Sub

mon fichier text d'origine ressemble à cela

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Type : Systme rducteur
Longueur des combinaisons : 2
Nombre de numros : 16
Nombre de combinaisons de base : 120
Nombre de combinaisons rduites : 8
Garantie du systme rducteur : 1/2
 
C 1	:    01    02    
C 30	:    03    04    
C 55	:    05    06    
C 76	:    07    08    
C 93	:    09    10    
C 106	:    11    12    
C 115	:    13    14    
C 120	:    15    16

je cherche donc a extraire et a mettre dans une feuille excel un chiffre par cellule les donnees situees apres les C1:, c30:, etc

Code:

1
2
3
4
5
6
7
8
C 1	:    01    02    
C 30	:    03    04    
C 55	:    05    06    
C 76	:    07    08    
C 93	:    09    10    
C 106	:    11    12    
C 115	:    13    14    
C 120	:    15    16

ex pour la ligne txt C1: on met en cellule B1 le chiffre 01, en C1 le chiffre 02
C30 : B2 le chiffre 03, en C2 le chiffre 04

etc .....

merci de votre aide

Salut, sans doute à adapter

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
Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
 
Sub Tst()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path
    Fichier = Application.GetOpenFilename("Fichier txt (*.txt), *.txt")
    If Fichier <> False Then Lire Fichier
End Sub
 
Private Sub Lire(ByVal NomFichier As String)
Dim sChaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer, Separateur As String
Dim Debut As Currency, Fin As Currency, Freq As Currency
 
    QueryPerformanceCounter Debut
    ShTst.Cells.Clear
    Application.ScreenUpdating = False
 
    Close
    NumFichier = FreeFile
 
    Separateur = " "
    Open NomFichier For Input As #NumFichier
        Do While Not EOF(NumFichier)
            iCol = 2
            Line Input #NumFichier, sChaine
            sChaine = Application.WorksheetFunction.Clean(sChaine)
            If Left(sChaine, 1) = "C" Then
                iRow = iRow + 1
                Ar = Split(sChaine, Separateur)
                For i = LBound(Ar) To UBound(Ar)
                    If IsNumeric(Ar(i)) Then
                        ShTst.Cells(iRow, iCol) = Ar(i)
                        iCol = iCol + 1
                    End If
                Next i
            End If
        Loop
    Close #NumFichier
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
 
    Application.StatusBar = Format((Fin - Debut) / Freq, "0.00 s")
    Application.ScreenUpdating = True
End Sub

08/05/2009, 07h42
oscar.cesar

bonjour à tous, kiki29
peux tu me mettre un peu de commentaire pour que je puisse tout comprendre
merci
08/05/2009, 11h39
kiki29

Salut, en plus de l'aide en ligne ( sélection du mot clé + F1 ) tu as
http://silkyroad.developpez.com/VBA/...nesCaracteres/
http://excel.developpez.com/sources/?page=sommaire
http://warin.developpez.com/access/fichiers/
10/05/2009, 12h46
oscar.cesar

bonjour à tous

apres avoir lance le code ci dessus

le debuggeur s'arrete sur la ligne

Code:

ShTst.Cells.Clear

j'avoue que je comprends pas ce SHTST.cells.clear
pour le .cells.clear , c'estr ok je vide les cellule ou je les efface ?

un peu d'aide merci
10/05/2009, 12h57
oscar.cesar

bonjour

ok j'ai eu l'info
il s'agit du nom de la feuille excel .
10/05/2009, 13h40
kiki29

Salut, c'est le CodeName, cela permet de ne pas modifier le code VBA en cas
de changement du nom d'onglet, de déplacement de la feuille ou d'ajout de feuilles
dans le classeur
voir http://silkyroad.developpez.com/VBA/...alcul/#LII-B-6