Extraire et mettre en forme un fichier texte en vba sous excel
Résolu
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
-
19 mai 2008 à 16:15
newcodeur Messages postés 25 Date d'inscription lundi 11 décembre 2000 Statut Membre Dernière intervention 1 juillet 2008 - 13 juin 2008 à 14:26
newcodeur Messages postés 25 Date d'inscription lundi 11 décembre 2000 Statut Membre Dernière intervention 1 juillet 2008 - 13 juin 2008 à 14:26
A voir également:
- Extraire et mettre en forme un fichier texte en vba sous excel
- Excel vba doevents - Conseils pratiques -Visual Basic / VB.NET
- Mettre en commentaire vba ✓ - Forum Visual Basic
- Vba ouvrir un fichier excel sans l'afficher ✓ - Forum Visual Basic 6
- VBA Excel : Commentaire ✓ - Forum Visual Basic 6
- Question idiote : mise en commentaire de plusieures lignes ✓ - Forum ASP / ASP.NET
30 réponses
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
20 mai 2008 à 12:01
20 mai 2008 à 12:01
Salut !!!
j'utilise finalement le code suivant
Sub Afficher()
Dim mot As String
Dim chaine As String
mot = "Create_"
Open "C:\Documents and Settings\ediaahm\Desktop\Counter_Analyser\log1.txt" For Input As 1
Line Input #1, chaine
Do While EOF(1)
chaine = Mid(mot, 8, 10)
Range("A1").Select = chaine
Loop
End Sub
mais il ne fonctionne pas .
ce que je voudrais sa serais d'afficher tous les mots aprés "Create_" dans une seule colonne ainsi que tous les mots de mon fichier commençant par pm dans une autre.
mais j'ai toujours des erreurs!!!
merci de votre aide.
j'utilise finalement le code suivant
Sub Afficher()
Dim mot As String
Dim chaine As String
mot = "Create_"
Open "C:\Documents and Settings\ediaahm\Desktop\Counter_Analyser\log1.txt" For Input As 1
Line Input #1, chaine
Do While EOF(1)
chaine = Mid(mot, 8, 10)
Range("A1").Select = chaine
Loop
End Sub
mais il ne fonctionne pas .
ce que je voudrais sa serais d'afficher tous les mots aprés "Create_" dans une seule colonne ainsi que tous les mots de mon fichier commençant par pm dans une autre.
mais j'ai toujours des erreurs!!!
merci de votre aide.
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
20 mai 2008 à 17:03
20 mai 2008 à 17:03
re;
tiens, c'est cadeau, ça fait plaisir, testé et approuvé :
Option Explicit
Private Sub Form_Load()
Dim sContenu As String
Dim sStringSearch As String
Dim ff As Integer
Dim lPlacement As Long
Dim lFin As Long
Dim lIndex As Long
Dim sValues() As String
ff = FreeFile: lIndex = -1
sStringSearch = "Create_"
Open "C:\Documents and
Settings\ediaahm\Desktop\Counter_Analyser\log1.txt" For Input As #ff
sContenu = Input$(LOF(ff), #ff)
Close #ff
Do
lPlacement = InStr(lPlacement + 1, sContenu, sStringSearch)
If lPlacement > 0 Then
lFin = InStr(lPlacement + 1, sContenu, " ")
lIndex = lIndex + 1
ReDim Preserve sValues(lIndex)
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - lPlacement +
Len(sStringSearch))
Else
Exit Do
End If
Loop
For lIndex = LBound(sValues) To UBound(sValues)
MsgBox sValues(lIndex)
Next lIndex
Erase sValues
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
tiens, c'est cadeau, ça fait plaisir, testé et approuvé :
Option Explicit
Private Sub Form_Load()
Dim sContenu As String
Dim sStringSearch As String
Dim ff As Integer
Dim lPlacement As Long
Dim lFin As Long
Dim lIndex As Long
Dim sValues() As String
ff = FreeFile: lIndex = -1
sStringSearch = "Create_"
Open "C:\Documents and
Settings\ediaahm\Desktop\Counter_Analyser\log1.txt" For Input As #ff
sContenu = Input$(LOF(ff), #ff)
Close #ff
Do
lPlacement = InStr(lPlacement + 1, sContenu, sStringSearch)
If lPlacement > 0 Then
lFin = InStr(lPlacement + 1, sContenu, " ")
lIndex = lIndex + 1
ReDim Preserve sValues(lIndex)
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - lPlacement +
Len(sStringSearch))
Else
Exit Do
End If
Loop
For lIndex = LBound(sValues) To UBound(sValues)
MsgBox sValues(lIndex)
Next lIndex
Erase sValues
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
23 mai 2008 à 16:55
23 mai 2008 à 16:55
j'ai quasiment fait tout ton dev, essaie plusieurs possibilité, c'est cherchant que l'on s'améliore.
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
19 mai 2008 à 16:18
19 mai 2008 à 16:18
salut,
suffit de lire ton fichier texte, et de placer contenu dans une variable.
ensuite, à coup de instr, tu récupères tes valeurs
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
suffit de lire ton fichier texte, et de placer contenu dans une variable.
ensuite, à coup de instr, tu récupères tes valeurs
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
19 mai 2008 à 22:25
19 mai 2008 à 22:25
Salut mortalino et merci de ton conseil
j'ai utilisé la fonction suivante :
Sub Nomdufichier()
Dim NomFichier
NomFichier = Application.GetOpenFilename
If VarType(NomFichier) = vbBoolean Then MsgBox "Action annulée" _
Else MsgBox "Fichier sélectionné : " & NomFichier
End Sub
mais je n'arrive toujours pas à extraire les informations désiré?
et pour le "instr" sa signifie instruction ?
Merci de ton aide .
j'ai utilisé la fonction suivante :
Sub Nomdufichier()
Dim NomFichier
NomFichier = Application.GetOpenFilename
If VarType(NomFichier) = vbBoolean Then MsgBox "Action annulée" _
Else MsgBox "Fichier sélectionné : " & NomFichier
End Sub
mais je n'arrive toujours pas à extraire les informations désiré?
et pour le "instr" sa signifie instruction ?
Merci de ton aide .
cs_lermite222
Messages postés
492
Date d'inscription
jeudi 5 avril 2007
Statut
Membre
Dernière intervention
2 juillet 2012
4
20 mai 2008 à 10:43
20 mai 2008 à 10:43
Bonjour,
tu peu essayé avec
Dim T
Dim Txt as string 'ton texte
T=Split(Txt,"Create_",-1)
dans le tableau T tu va avoir
T(1) = "Create_"
et dans T(2) tu va avoir la suite
for i=1 to len(T(2)
if mid(T(2)="" then exit for
next i
LeNomQueTuCherche = left(T(2),i-1)
Si j'ai bien compris...
A+
tu peu essayé avec
Dim T
Dim Txt as string 'ton texte
T=Split(Txt,"Create_",-1)
dans le tableau T tu va avoir
T(1) = "Create_"
et dans T(2) tu va avoir la suite
for i=1 to len(T(2)
if mid(T(2)="" then exit for
next i
LeNomQueTuCherche = left(T(2),i-1)
Si j'ai bien compris...
A+
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
20 mai 2008 à 17:16
20 mai 2008 à 17:16
Merci beaucoup !!!
Je vais maintenant à partir de ce que tu m'a donné afficher sa directement dans une feuille excel avec les pm associés je te tiendrais informé de la suite.
Merci!!!!
Ps: j'ai beuacoup de chemin à faire pour devenir un as de la prog!!!!!
Je vais maintenant à partir de ce que tu m'a donné afficher sa directement dans une feuille excel avec les pm associés je te tiendrais informé de la suite.
Merci!!!!
Ps: j'ai beuacoup de chemin à faire pour devenir un as de la prog!!!!!
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
22 mai 2008 à 11:14
22 mai 2008 à 11:14
Salut !!!
j'ai réussi a afficher les valeurs dans la colonne A de la feuillle excel (parce que les valeurs doivent s'afficher dans une feuille excel et non pas une msgbox , j'avais mal formulé mon pb désolé)
par contre je n'arrive toujours pas a afficher les mots commençant par pm.... qui leurs sont associés (les pm devront quant à eux se trouver dans la colonne B)
j'ai testé plusieurs boucle a l'intérieur de la premeière boucle mais sa ne donne rien???
comment dois-je faire????
voici mon code (ou plutôt ton code !!! ):
Option Explicit
Private Sub Form_Load()
Dim sContenu As String
Dim sStringSearch As String
Dim ff As Integer
Dim lPlacement As Long
Dim lFin As Long
Dim lIndex As Long
Dim sValues() As String
Dim vara As Long, varb
ff FreeFile: lIndex -1
sStringSearch = "Create_"
Open "C:\Documents and Settings\ediaahm\Desktop\Counter_Analyser\log.txt" For Input As #ff
sContenu = Input$(LOF(ff), #ff)
Close #ff
vara = 1
varb = 2
'cleanning of the [AFFICH_log] sheet
Sheets("Sheet2").Cells.ClearContents
Sheets("Sheet2").Activate
Do
lPlacement = InStr(lPlacement + 1, sContenu, sStringSearch)
If lPlacement > 0 Then
lFin = InStr(lPlacement + 1, sContenu, " ")
lIndex = lIndex + 1
ReDim Preserve sValues(lIndex)
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - lPlacement + Len(sStringSearch))
Else
Exit Do
End If
Loop
For lIndex = LBound(sValues) To UBound(sValues)
'MsgBox sValues(lIndex)
ActiveSheet.Cells(varb, 1) = sValues(lIndex)
varb = varb + 1
ActiveSheet.Columns.AutoFit
Next lIndex
Erase sValues
End Sub
j'ai réussi a afficher les valeurs dans la colonne A de la feuillle excel (parce que les valeurs doivent s'afficher dans une feuille excel et non pas une msgbox , j'avais mal formulé mon pb désolé)
par contre je n'arrive toujours pas a afficher les mots commençant par pm.... qui leurs sont associés (les pm devront quant à eux se trouver dans la colonne B)
j'ai testé plusieurs boucle a l'intérieur de la premeière boucle mais sa ne donne rien???
comment dois-je faire????
voici mon code (ou plutôt ton code !!! ):
Option Explicit
Private Sub Form_Load()
Dim sContenu As String
Dim sStringSearch As String
Dim ff As Integer
Dim lPlacement As Long
Dim lFin As Long
Dim lIndex As Long
Dim sValues() As String
Dim vara As Long, varb
ff FreeFile: lIndex -1
sStringSearch = "Create_"
Open "C:\Documents and Settings\ediaahm\Desktop\Counter_Analyser\log.txt" For Input As #ff
sContenu = Input$(LOF(ff), #ff)
Close #ff
vara = 1
varb = 2
'cleanning of the [AFFICH_log] sheet
Sheets("Sheet2").Cells.ClearContents
Sheets("Sheet2").Activate
Do
lPlacement = InStr(lPlacement + 1, sContenu, sStringSearch)
If lPlacement > 0 Then
lFin = InStr(lPlacement + 1, sContenu, " ")
lIndex = lIndex + 1
ReDim Preserve sValues(lIndex)
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - lPlacement + Len(sStringSearch))
Else
Exit Do
End If
Loop
For lIndex = LBound(sValues) To UBound(sValues)
'MsgBox sValues(lIndex)
ActiveSheet.Cells(varb, 1) = sValues(lIndex)
varb = varb + 1
ActiveSheet.Columns.AutoFit
Next lIndex
Erase sValues
End Sub
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
22 mai 2008 à 17:51
22 mai 2008 à 17:51
re,
je te l'ai fait en Fonction, ce sera plus simple d'utilisation, regarde surtout la sub exemple, la Function ne doit ^pas être modifée :
Option Explicit
Private Function ExtractDatas(ByVal sStringSearch As String, sValues() As String) As Boolean
Dim sContenu As String
Dim ff As Integer
Dim lPlacement As Long
Dim lFin As Long
Dim lIndex As Long
ff = FreeFile: lIndex = -1
Open "C:\Documents and
Settings\ediaahm\Desktop\Counter_Analyser\log1.txt" For Input As #ff
sContenu = Input$(LOF(ff), #ff)
Close #ff
Do
lPlacement = InStr(lPlacement + 1, sContenu, sStringSearch)
If lPlacement > 0 Then
lFin = InStr(lPlacement + 1, sContenu, " ")
If InStr(lPlacement + 1, sContenu, vbCrLf) < lFin
Then lFin = InStr(lPlacement + 1, sContenu,
vbCrLf)
If lFin = 0 Then lFin = Len(sContenu)
lIndex = lIndex + 1
ReDim Preserve sValues(lIndex)
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - (lPlacement
+ Len(sStringSearch)))
Else
Exit Do
End If
Loop
ExtractDatas = True
End Function
Sub test()
Dim myValues1() As String, myValues2() As String, lIndex As Long
Dim i As Integer
If ExtractDatas("Create_", myValues1) Then
For lIndex = LBound(myValues1) To UBound(myValues1)
i = i + 1
Cells(i, 1).Value = myValues1(lIndex)
Next lIndex
Erase myValues1
End If
i = 0
If ExtractDatas("pm", myValues2) Then
For lIndex = LBound(myValues2) To UBound(myValues2)
i = i + 1
Cells(i, 2).Value = myValues2(lIndex)
Next lIndex
Erase myValues2
End If
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
je te l'ai fait en Fonction, ce sera plus simple d'utilisation, regarde surtout la sub exemple, la Function ne doit ^pas être modifée :
Option Explicit
Private Function ExtractDatas(ByVal sStringSearch As String, sValues() As String) As Boolean
Dim sContenu As String
Dim ff As Integer
Dim lPlacement As Long
Dim lFin As Long
Dim lIndex As Long
ff = FreeFile: lIndex = -1
Open "C:\Documents and
Settings\ediaahm\Desktop\Counter_Analyser\log1.txt" For Input As #ff
sContenu = Input$(LOF(ff), #ff)
Close #ff
Do
lPlacement = InStr(lPlacement + 1, sContenu, sStringSearch)
If lPlacement > 0 Then
lFin = InStr(lPlacement + 1, sContenu, " ")
If InStr(lPlacement + 1, sContenu, vbCrLf) < lFin
Then lFin = InStr(lPlacement + 1, sContenu,
vbCrLf)
If lFin = 0 Then lFin = Len(sContenu)
lIndex = lIndex + 1
ReDim Preserve sValues(lIndex)
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - (lPlacement
+ Len(sStringSearch)))
Else
Exit Do
End If
Loop
ExtractDatas = True
End Function
Sub test()
Dim myValues1() As String, myValues2() As String, lIndex As Long
Dim i As Integer
If ExtractDatas("Create_", myValues1) Then
For lIndex = LBound(myValues1) To UBound(myValues1)
i = i + 1
Cells(i, 1).Value = myValues1(lIndex)
Next lIndex
Erase myValues1
End If
i = 0
If ExtractDatas("pm", myValues2) Then
For lIndex = LBound(myValues2) To UBound(myValues2)
i = i + 1
Cells(i, 2).Value = myValues2(lIndex)
Next lIndex
Erase myValues2
End If
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
23 mai 2008 à 11:58
23 mai 2008 à 11:58
Encore merci mortalino !!!mais le pb est que pour la colonne B je dois avoir le pm devant chaque mot et puis je dois pouvoir associer chaque mot aprés "Create_" avec les pm qui lui sont associés par contre je dois garder le mot pm deavnt chaque conteur de la colonne B ex:
voici un exemple de la mise en forme final les etoile !!!!!)
Colonne A Colonne B
*******************************************
E1Ttp pmEs
pmSes
pmUas
******************************************
PlugInUnit pmProcessorLoad
*********************************************
TdmTermGrp pmNrOfTdmTermsBusy
pmNrOfTdmTermsRej
pmNrOfTdmTermsReq
**************************************
voici un exemple de la mise en forme final les etoile !!!!!)
Colonne A Colonne B
*******************************************
E1Ttp pmEs
pmSes
pmUas
******************************************
PlugInUnit pmProcessorLoad
*********************************************
TdmTermGrp pmNrOfTdmTermsBusy
pmNrOfTdmTermsRej
pmNrOfTdmTermsReq
**************************************
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
23 mai 2008 à 13:14
23 mai 2008 à 13:14
dans la fontion, cahnge
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - (lPlacement + Len(sStringSearch)))
pour
If sStringSearch = "pm" then
sValues(lIndex) = Mid$(sContenu, lPlacement, lFin - (lPlacement + Len(sStringSearch)))
else
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - (lPlacement + Len(sStringSearch)))
end if
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - (lPlacement + Len(sStringSearch)))
pour
If sStringSearch = "pm" then
sValues(lIndex) = Mid$(sContenu, lPlacement, lFin - (lPlacement + Len(sStringSearch)))
else
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - (lPlacement + Len(sStringSearch)))
end if
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
23 mai 2008 à 14:41
23 mai 2008 à 14:41
salut j'ai rajouter la fonction mais il y a les deux derniers caractères pour les expressions de la colonne b qui ne s'affichent plus ?
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
23 mai 2008 à 14:45
23 mai 2008 à 14:45
If sStringSearch = "pm" then
sValues(lIndex) =
Mid
$(sContenu, lPlacement
, lFin - (lPlacement +
Len
(sStringSearch)))
else
sValues(lIndex) =
Mid
$(sContenu, lPlacement +
Len
(sStringSearch), lFin - (lPlacement+
Len
(sStringSearch))
)
end if
enlève ce qui a en rouge
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
sValues(lIndex) =
Mid
$(sContenu, lPlacement
, lFin - (lPlacement +
Len
(sStringSearch)))
else
sValues(lIndex) =
Mid
$(sContenu, lPlacement +
Len
(sStringSearch), lFin - (lPlacement+
Len
(sStringSearch))
)
end if
enlève ce qui a en rouge
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
23 mai 2008 à 15:00
23 mai 2008 à 15:00
salut j'ai fais ce que tu m'a dit mais j'ai toujours le meme pb ?
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
23 mai 2008 à 15:06
23 mai 2008 à 15:06
lol, tu m'étonnes, suis pas encore réveillé, j'ai fait une boulette.
Enlève ce qui a en rouge mais sur la ligne AVANT le Else.
Ce qui a après en fait, il ne faut rien enlever
Pff.. je suis mauvais
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
Enlève ce qui a en rouge mais sur la ligne AVANT le Else.
Ce qui a après en fait, il ne faut rien enlever
Pff.. je suis mauvais
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
23 mai 2008 à 15:14
23 mai 2008 à 15:14
OKIIIII!!!!!!!
sa marche c vraiment gentil!!!!
ilne me reste plus qu'a mettre sa en forme je te tiens au courant @++
sa marche c vraiment gentil!!!!
ilne me reste plus qu'a mettre sa en forme je te tiens au courant @++
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
23 mai 2008 à 15:49
23 mai 2008 à 15:49
Sinon est-ce que tu pourrais m'expliquer globalement comment le programme fonctionne???
d'aprés ce que j'ai vu il sélectionne les mots par rapports à leurs taille
est-ce vrai ???
d'aprés ce que j'ai vu il sélectionne les mots par rapports à leurs taille
est-ce vrai ???
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
23 mai 2008 à 16:08
23 mai 2008 à 16:08
je t'ai mis qques comm :
Private Function ExtractDatas(ByVal sStringSearch As String, sValues() As String) As Boolean
Dim sContenu As String
Dim ff As Integer
Dim lPlacement As Long
Dim lFin As Long
Dim lIndex As Long
' freefile donne un
numéro d'acces libre pour fichier :
ff = FreeFile: lIndex = -1
'ouverture du fichier, récupération des données, puis fermeture
:
Open "C:\Documents
and Settings\ediaahm\Desktop\Counter_Analyser\log1.txt" For Input As #ff
sContenu = Input$(LOF(ff), #ff)
Close #ff
' Do fait une boucle
:
Do
lPlacement récupére la position du mot recherché :
lPlacement = InStr(lPlacement + 1, sContenu, sStringSearch)
If lPlacement > 0 Then
'
la fin est récupéré par l'espace qui vient après la
recherche..
lFin = InStr(lPlacement + 1, sContenu, " ")
'.. ou par le saut de ligne :
If InStr(lPlacement + 1, sContenu, vbCrLf) < lFin Then
lFin = InStr(lPlacement + 1, sContenu, vbCrLf)
' le dernier
caaract n'est ni l'un ni 'autre. Donc c'est le dernier carac du fichier
:
If lFin = 0 Then lFin = Len(sContenu)
lIndex = lIndex + 1
ReDim Preserve sValues(lIndex)
' si pmtatatiti
est à partir du caractère 10, _
lplacement vaut 10, lFin vaut 20, et fdonc 20 - 10 =>
10 _
Mid extrait donc
la valeur avec ces paramètres
If sStringSearch = "pm" then
sValues(lIndex) = Mid$(sContenu, lPlacement, lFin - lPlacement)
else
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - (lPlacement
+ Len(sStringSearch)))
end if
Else
Exit Do
End If
Loop
ExtractDatas = True
End Function
Sub test()
Dim myValues1() As String, myValues2() As String, lIndex As Long
Dim i As Integer
If ExtractDatas("Create_", myValues1) Then
For lIndex = LBound(myValues1) To UBound(myValues1)
i = i + 1
Cells(i, 1).Value = myValues1(lIndex)
Next lIndex
Erase myValues1
End If
i = 0
If ExtractDatas("pm", myValues2) Then
For lIndex = LBound(myValues2) To UBound(myValues2)
i = i + 1
Cells(i, 2).Value = myValues2(lIndex)
Next lIndex
Erase myValues2
End If
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
Private Function ExtractDatas(ByVal sStringSearch As String, sValues() As String) As Boolean
Dim sContenu As String
Dim ff As Integer
Dim lPlacement As Long
Dim lFin As Long
Dim lIndex As Long
' freefile donne un
numéro d'acces libre pour fichier :
ff = FreeFile: lIndex = -1
'ouverture du fichier, récupération des données, puis fermeture
:
Open "C:\Documents
and Settings\ediaahm\Desktop\Counter_Analyser\log1.txt" For Input As #ff
sContenu = Input$(LOF(ff), #ff)
Close #ff
' Do fait une boucle
:
Do
lPlacement récupére la position du mot recherché :
lPlacement = InStr(lPlacement + 1, sContenu, sStringSearch)
If lPlacement > 0 Then
'
la fin est récupéré par l'espace qui vient après la
recherche..
lFin = InStr(lPlacement + 1, sContenu, " ")
'.. ou par le saut de ligne :
If InStr(lPlacement + 1, sContenu, vbCrLf) < lFin Then
lFin = InStr(lPlacement + 1, sContenu, vbCrLf)
' le dernier
caaract n'est ni l'un ni 'autre. Donc c'est le dernier carac du fichier
:
If lFin = 0 Then lFin = Len(sContenu)
lIndex = lIndex + 1
ReDim Preserve sValues(lIndex)
' si pmtatatiti
est à partir du caractère 10, _
lplacement vaut 10, lFin vaut 20, et fdonc 20 - 10 =>
10 _
Mid extrait donc
la valeur avec ces paramètres
If sStringSearch = "pm" then
sValues(lIndex) = Mid$(sContenu, lPlacement, lFin - lPlacement)
else
sValues(lIndex) = Mid$(sContenu, lPlacement + Len(sStringSearch), lFin - (lPlacement
+ Len(sStringSearch)))
end if
Else
Exit Do
End If
Loop
ExtractDatas = True
End Function
Sub test()
Dim myValues1() As String, myValues2() As String, lIndex As Long
Dim i As Integer
If ExtractDatas("Create_", myValues1) Then
For lIndex = LBound(myValues1) To UBound(myValues1)
i = i + 1
Cells(i, 1).Value = myValues1(lIndex)
Next lIndex
Erase myValues1
End If
i = 0
If ExtractDatas("pm", myValues2) Then
For lIndex = LBound(myValues2) To UBound(myValues2)
i = i + 1
Cells(i, 2).Value = myValues2(lIndex)
Next lIndex
Erase myValues2
End If
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
23 mai 2008 à 16:33
23 mai 2008 à 16:33
Merci c cool est bon week end!!!!
newcodeur
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
23 mai 2008 à 16:49
23 mai 2008 à 16:49
Juste une derniere question je voudrais faire une boucle dans la prmeière boucle de la fonction test pour avoir la cellule A1 remplit ensuite la cellule B1 à BX remplit je saute une ligne puis la cellule "An" remplit ensuite la "Bn" qui se remplit jusqu'a "Bx"
pour avoir les donnees formatés de cette façon :
Colonne A Colonne B
*******************************************
E1Ttp pmEs
pmSes
pmUas
******************************************
PlugInUnit pmProcessorLoad
*********************************************
TdmTermGrp pmNrOfTdmTermsBusy
pmNrOfTdmTermsRej
pmNrOfTdmTermsReq
Merci
pour avoir les donnees formatés de cette façon :
Colonne A Colonne B
*******************************************
E1Ttp pmEs
pmSes
pmUas
******************************************
PlugInUnit pmProcessorLoad
*********************************************
TdmTermGrp pmNrOfTdmTermsBusy
pmNrOfTdmTermsRej
pmNrOfTdmTermsReq
Merci
