Remplir un tableau XCL à partir de fichiers TXT
Bonjour à toutes et à tous,
Je dispose de fichiers TXT (environ 900, 3 Ko chacun) qui ont tous la même organisation.
Pour l'instant ces fichiers sont sur un dossier local de mon PC.
J'ai créé un fichier XCL listant les chemins d'accès à ces fichiers (tableau 1 col x environ 900 lignes)
Je souhaite constituer un tableau (ou BDD) en extrayant quelques arguments (une dizaine, toujours les mêmes) de chaque fichier TXT.
Lorsqu'un fichier TXT est copié en données externes sur une feuille XCL, j'ai écrit une macro ("extraction") qui me donne le résultat que je souhaite.
Par contre c'est l'automatisation de la copie du contenu du fichier TXT (pour passer au suivant) qui me pose problème.
Il faut écrire ce morceau de macro en langage VBA, avec une boucle, et là je ne suis pas assez expert.
J'ai pensé à la fonction "Connection", mais je ne connais pas sa syntaxe, et je ne suis pas sûr que ce soit la meilleure solution.
Pour être précis, je souhaite réaliser le programme suivant :
• Copier le premier fichier TXT de la liste en A1 d'une feuille XCL (feuille "auxiliaire")
• Lancer la macro "extraction" (extraction des données, saisie de ces données dans la première ligne du tableau cible)
• Copier le fichier TXT suivant de la liste en A1 de la feuille "auxiliaire" (en écrasant le précédent)
• Lancer la macro "extraction" (saisie des données dans la ligne suivante du tableau cible)
• Boucle jusqu'au dernier fichier TXT de la liste
Quelqu'un peut-il m'aider ?
Merci d'avance.
Bonsoir,
une proposition à adapter
Sub charger()
Set tws = ThisWorkbook.Sheets("auxiliaire")
chemin = "f:" '<- adapter la variable chemin
f = Dir(chemin & "\*.txt")
While f <> ""
Workbooks.OpenText chemin & "\" & f
Set wbt = Workbooks(f)
dls = wbt.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
dlt = tws.Cells(Rows.Count, 1).End(xlUp).Row
wbt.Sheets(1).Range("A1", Cells(dls, 1)).Copy tws.Cells(dlt + 1, 1)
wbt.Close
f = Dir()
Wend
End SubBonjour h2so4
Merci pour la rapidité et la balèzitude de ta réponse. Concis, efficace, elle a marché du premier coup, enfin quand j'ai eu compris les adaptations nécessaires. Respect.
Après ça, tu me vois venir, il y a encore 2-3 trucs à modifier pour que le résultat tombe dans ma cible.
1. Dans la feuille "auxiliaire" la macro met une cellule vide en A1. Ce n'est pas trop gênant parce que stable, mais si on peut éviter …
2. Ensuite elle écrit les fichiers TXT à la suite les uns des autres, ce qui ne me convient pas pour y appliquer la macro d'extraction. Je souhaite écrire un fichier, à partir de A1 ou A2, peu importe, ensuite extraire les données souhaitées, ensuite écrire le fichier suivant au même endroit pour appliquer la même macro d'extraction.
3. Ma question suivante est : où dois-je insérer l'instruction pour lancer la macro d'extraction ?
4. En outre ta macro recopie certains fichiers correctement, et d'autres avec seulement les 2 premiers caractères de chaque ligne. Ça paraît aléatoire, mais ça ne l'est bien sûr pas et ça dépend des fichiers TXT. Par contre je n'ai pas encore pu chercher l'origine de la différence : le nom, la structure, les caractères …
Si tu peux m'éclairer sur 1,2 et 3, merci d'avance. 4 je cherche, mais si tu as des idées …
@+
bonjour
macro adaptée
Sub charger()
Set tws = ThisWorkbook.Sheets("auxiliaire") ' feuille auxiliaire (1) voir ci-dessous
chemin = "f:" '<- adapter la variable chemin
f = Dir(chemin & "\*.txt") 'prendre tous les fichiers txt du répertoire chemin
While f <> "" ' tant qu'il y a des fichiers
Workbooks.OpenText chemin & "\" & f 'ouvrir le fichier
Set wbt = Workbooks(f) ' classeur xl* contenant le fichier txt
dls=wbt.sheets(1).cells(rows.count,1).end(xlup).row ' dernière ligne du fichier txt
wbt.Sheets(1).Range("A1", Cells(dls, 1)).Copy tws.Cells(1, 1) ' copie du fichier txt dans feuille auxiliaire en A1 (demande 1 et 2)
' je suppose que la macro d'extraction lit les données (1) d'une feuille pour les écrire dans une autre(2). la macro fait l'hypothèse que la feuille auxiliaire est la feuille (1). SI ce n'est pas le cas changer le nom dans la première instruction
call macrodextraction '(demande 3)
wbt.Close ' fermer fichier txt
f = Dir() 'prendre fichier suivant
Wend
End SubSub extraction()
'
'
Sheets("Auxiliaire").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(MatLignes)"
' sélection des lignes à retenir / 12 sur 58
Selection.AutoFill Destination:=Range("B1:B12"), Type:=xlFillDefault
Range("B1:B12").Select
Range("C1").Select
' sélection des morceaux à extraire de chaque ligne
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-1],LEN(RC[-1])-FIND("":"",RC[-1])-1)"
Selection.AutoFill Destination:=Range("C1:C12"), Type:=xlFillDefault
Range("C8").Select
' traitement spécial des lignes 8 9 12 (données numériques)
ActiveCell.FormulaR1C1 = _
"=VALUE(RIGHT(RC[-1],LEN(RC[-1])-FIND("":"",RC[-1])-1))"
Selection.AutoFill Destination:=Range("C8:C9"), Type:=xlFillDefault
Range("C12").Select
Selection.Cut Destination:=Range("D12")
Range("C12").Select
ActiveCell.FormulaR1C1 = "=VALUE(LEFT(RC[1],FIND("" "",RC[1])-1))"
' recopie valeurs transposées dans la feuille "synthèse"
Range("B13:M13").Select
Selection.FormulaArray = "=TRANSPOSE(R[-12]C[1]:R[-1]C[1])"
Selection.Copy
Sheets("Synthèse").Select
Application.Goto Reference:="INDIRECT(R1C15)"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
T'as tout bon. La macro extraction qui va bien. Je l'ai écrite avec l'enregistrement automatique, œuf corse.
Elle recopie les données à la première ligne vide de la feuille synthèse, ce qui permet de travailler à plusieurs et/ou en plusieurs fois successivement sur le même fichier. On triera les doublons à un moment donné, et on vérifiera les omissions avec le nb d'enregistrements / nb de fichiers TXT.
Merci de ton aide très efficace.
PS : je ne sais pas inclure dans mon message une belle copie bien propre de la macro, avec les styles. Désolé, j'espère que c'est assez clair qd même.