VBA- Création macro pour extraire des données spécifique d'un fichier texte
Je souhaite obtenir des données d'un fichier texte (issus du G-code pour l'impression 3D) et les importer dans des cellules sur mon outil Excel. Est-il possible de faire une macro pour ce genre de cas ?
Mon problème est que les fichiers txt comportent plusieurs centaines de milliers de lignes avec comme séparateur des "," ou ":". J'ai essayé une première macro mais qui me faisait remonter les données de toutes les lignes, hors seulement quelques données me sont nécessaires dans quelques lignes particulières. (Data à récolter= Build time,Plastic weight,printMaterial). J'ai inclus les Screenshots du texte (en surligné les informations à extraire) et les cellules dans lesquels j'aimerai importer ces données sont remplis en vert sur le excel test joint. Le fichier texte joint est une version simplifiée, avec uniquement quelques données au début et à la fin qui sont systématiquement à ces emplacements (données avec les ; en début de ligne), toutes les autres lignes (plusieurs centaines de milliers) me sont inutile.
Je vous remercie d'avance pour l'aide apportée !
bonsoir
une proposition de solution via une macro
Sub extraction()
finligne = vbCrLf
fichier = "d:\downloads\testgcode.txt"
With Sheets("feuil1")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ft = FSO.OpenTextFile(fichier, 1)
textstring = ft.ReadAll
ft.Close
.Range("c8") = gettext(textstring, "processName,", finligne)
.Range("C9") = gettext(textstring, "extruderName,", finligne)
.Range("C18") = gettext(textstring, "Plastic weight: ", " g (")
.Range("C16") = gettext(textstring, "Filament length: ", " mm (") / 1000
.Range("C21") = gettext(textstring, "Plastic volume: ", " mm")
.Range("C24") = gettext(textstring, "printMaterial,", finligne)
.Range("C31") = gettext(textstring, "Build time: ", finligne)
End With
End Sub
Function gettext(texte, sep1, sep2, Optional position = 1)
'renvoie le texte entre les séparateurs sep1 et sep2
s1 = InStr(position, texte, sep1)
If s1 <> 0 Then
s2 = InStr(s1 + Len(sep1), texte, sep2)
If s2 <> 0 Then
t = Mid(texte, s1 + Len(sep1), s2 - (s1 + Len(sep1)))
gettext = t
End If
End If
End FunctionBonjour, la macro fonctionne parfaitement , merci beaucoup !
J'aimerai juste si possible allé chercher manuellement le fichier texte dans un dossier étant donné que le fichier va changer régulièrement selon la pièce imprimée.
J'avais fais une petite macro de ce genre mais ca ne semble plus fonctionner avec la suite de votre macro. Est-il possible de la modifier pour que ca fonctionne avec la suite de la macro ?
Seconde question: est-il possible de ne pas remonter le mot "hours" pour la donnée "build time" et ne récupérer donc que le 19 (h) et 12(min) ? J'ai une formule qui utilise le temps pour calculer la consommation énergétique et le fait de remonter le mot "hours" bloque ma formule.
Merci pour votre temps et réponses !
Dim dialogBox As FileDialog
Dim selectedfile As String
Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
With dialogBox
.Filters.Add "txt", "*.txt", 1
.AllowMultiSelect = False
If .Show = True Then
selectedfile = .SelectedItems(1)
End If
Debug.Print selectedfile
End WithPour la seconde question 'exclure les mots "hours" et "min" j'y suis arrivé en modifiant cette ligne et en passant le résultat en seconde donc c'est OK. Toujours preneur pour la sélection du fichier à la main.
.Range("D32") = gettext(textstring, "Build time: ", "hours") * 3600 + gettext(textstring, "hours ", "min") * 60bonjour,
code adapté. renvoie le temps en format excel.
Sub extraction()
finligne = vbCrLf
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "txt", "*.txt", 1
.AllowMultiSelect = False
If .Show = True Then
fichier = .SelectedItems(1)
End If
End With
With Sheets("feuil1")
Set fso = CreateObject("Scripting.FileSystemObject")
Set ft = fso.OpenTextFile(fichier, 1)
textstring = ft.ReadAll
ft.Close
.Range("c8") = gettext(textstring, "processName,", finligne)
.Range("C9") = gettext(textstring, "extruderName,", finligne)
.Range("C18") = gettext(textstring, "Plastic weight: ", " g (")
.Range("C16") = gettext(textstring, "Filament length: ", " mm (") / 1000
.Range("C21") = gettext(textstring, "Plastic volume: ", " mm")
.Range("C24") = gettext(textstring, "printMaterial,", finligne)
.Range("C31") = (gettext(textstring, "Build time: ", " hours") + gettext(textstring, "hours ", " minutes") / 60) / 24
.Range("C31").NumberFormat = "[h]:mm"
End With
End Sub
Function gettext(texte, sep1, sep2, Optional position = 1)
'renvoie le texte entre les séparateurs sep1 et sep2
s1 = InStr(position, texte, sep1)
If s1 <> 0 Then
s2 = InStr(s1 + Len(sep1), texte, sep2)
If s2 <> 0 Then
t = Mid(texte, s1 + Len(sep1), s2 - (s1 + Len(sep1)))
gettext = t
End If
End If
End FunctionSuper, tout fonctionne. Merci
Bonjour
J%'arrive après la bataille mais j'ai essayé une solution avec power query que j'aimerais bien tester sur plus de données rien que pour le fun ...
Pourrais tu m'adresser un fichier texte plus important ?
Merci
Cordialement
FINDRH
Bonjour,
Pas de problème!
La limite de fichier est de 1.5 Mo, j'essaie de te trouver une impression avec un Gcode moins volumineux.
Je t'ai trouvé un fichier avec environ 10k lignes, j'espère que ça te suffira. On est loin des 680k lignes de l'impression précédentes mais je ne peux pas te partager de fichier trop volumineux.
Bonjour
Ci joint une proposition avec les explications nécessaires. Je ne connait pas ton niveau et tes connaissances sur query....
J'ai donc rajouté des explis qui j'espère te seront utiles au pire, inutiles au mieux !!!
Il n'y a qu'à changer le chemin critique dans la source de la requête par un copier coller et le tour est joué.... (???)
A ta dispo
Cordialement
FINDRH