Importation fichier txt en groupe

jojo2006

XLDnaute Occasionnel
Bonjour à tous,

Je suis en train de réaliser un code vba pour traiter un fichier de point txt ( nuage de point X et Y).

J’ai réalisé la partie traitement, détection des signaux et calcul pour un seul fichier txt.

Je souhaiterai maintenant créer une macro qui me permet de sélectionner tous mes fichiers txt et de les importer dans un seul classeur avec le nom de chaque fichier sur la première ligne.

Je dois aussi supprimer les caractères d’ouverture et de fermeture qui sont en début et en fin de fichier. Tous les fichiers txt ne font pas la même taille.


J’ai commençé le code avec une box qui s’ouvre et qui demande de sélectionner tous les fichiers (pas forcément dans le même que le fichier excel contenant la macro import souhaitée) en commençant par le dernier pour les classer dans l’ordre dans le classeur.


J’ai mis un exemple du fichier xls que je souhaiterai obtenir après l’importation de tous mes fichiers txt ainsi que 3 fichiers txt.

Avez-vous une idée pour compléter mon début de code et réaliser la macro ?

Je vous remercie d’avance pour votre aide

Bonne journée à tous et merci !

Jojo




Sub Feuil1_Bouton1_Cliquer()
Dim o As String
Dim OuvrirFichier As FileDialog
Dim FichierSélectionné As Variant
Set OuvrirFichier = Application.FileDialog(msoFileDialogOpen)
With OuvrirFichier
.AllowMultiSelect = True
.Show
For Each FichierSélectionné In .SelectedItems
o = FichierSélectionné
‘nom du fichier
‘importer données
‘convertir séparateur espace
‘supprimer entête et fin de fichier
‘copier nomfichier en première ligne
Next
'convertir point en virgule de tout le classeur
End With

Application.ScreenUpdating = True
 

Pièces jointes

  • fichier_import.xlsx
    428.5 KB · Affichages: 29
  • multi_profils1.txt
    279.1 KB · Affichages: 25
  • multi_profils2.txt
    275.3 KB · Affichages: 20
  • multi_profils3.txt
    36.8 KB · Affichages: 23
Dernière édition:

herve62

XLDnaute Barbatruc
Supporter XLD
Bonjour tous
IL y a une méthode connue de EXCEL qui permet d'importer directement des données externes ( généralement TXT) . ce que je viens de faire et en l'enregistrant en temps que macro
Enregistrer macro :
Données > A partir du texte : là tu indiques ton fichier à importer
la fenêtre spécifique s'ouvre : tu laisses délimité , puis indique ligne début 3 ( pour ne garder que tes données)
ensuite : Separateur> Espace ( rien d'autre) , identificateur texte : aucun
Terminer : là il te demande ta case de début ( ex G2 pour ton fichier) > OK
Le résultat est là
fin enreg macro
Je te joins ce que cela donne , ensuite restera le traitement personnalisé en VBA , pour mettre en auto les fichiers , j'ai mis un exempleavec variable chemin fichier et cel de départ
Pour toi, tu remplaces le chemin pour ton fichier
Ce fichier n'est qu'une ébauche de départ donc à poursuivre/modifier
 

Pièces jointes

  • importTXT.xlsm
    443.7 KB · Affichages: 26

jojo2006

XLDnaute Occasionnel
Bonjour,


j'ai réalisé ce code sur les conseils de hervé62 merci !

par contre je cherche maintenant à récupérer juste le nom du fichier ( pas le lien hypertexte).

Si vous avez une idée.

Merci




Sub import2()


Dim lien_fichier As String

Dim OuvrirFichier As FileDialog
Dim FichierSélectionné As Variant

Set OuvrirFichier = Application.FileDialog(msoFileDialogOpen)

With OuvrirFichier
.AllowMultiSelect = True
.Show
i = 1

For Each FichierSélectionné In .SelectedItems

lien_fichier = FichierSélectionné


With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & lien_fichier, Destination:=Range(Cells(2, i), Cells(2, i))) ' On insère les variables ici
.Name = "multi_profils1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 3
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With


Next



i = i + 2

End With

Application.ScreenUpdating = True



End Sub
 

herve62

XLDnaute Barbatruc
Supporter XLD
Bonsoir
Parfois il faut savoir simplifier la racine de la source .. à savoir :
N'est il pas possible que tous les fichiers .TXT soient regroupés dans le même répertoire ?
ensuite c'est tout simple , j'ai gardé une appli que j'avais fait pour un membre ici il y a qq années
très similaire sauf avec des fic en xls !!
J'ai testé ta sub > Une boite s'ouvre pour selectionner , avec ma solution pas besoin
On va repérer tous les .TXT d'un répertoire, les ouvrir ( sans voir) 1 par 1 via boucle en récupérant les data , et les recopier dans le fichier base donc avec la sub que je t'ai mis
Si Ok je te laisserai le code ; La seule contrainte est soit :
- mettre en dur le chemin dans une variable du code
- soit une box s'ouvre et l'utilisateur entre le chemin , on le récupère en variable
 

jojo2006

XLDnaute Occasionnel
Bonsoir Hervé

Je dois garder la possibilité de choisir les fichiers manuellement.

Il faut que je trouve le moyen de récupérer juste le nom du fichier TXT.

Si vous avez une solution pour splitter le lien hypertexte peut être avec la fonction Lens je suis preneur.

Merci d'avance

Bonne soirée
Jo
 

job75

XLDnaute Barbatruc
Bonjour jojo2006, herve62, le forum,

Une solution très classique :
Code:
Sub Import()
Dim dest As Range, f, h&
With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = True
    .Show
    Application.ScreenUpdating = False
    Cells.Delete 'RAZ
    Rows(1).HorizontalAlignment = xlCenter
    Rows("1:2").Font.Bold = True 'gras
    Set dest = [A3]
    For Each f In .SelectedItems
        If f Like "*.txt" Then
            With Workbooks.Open(f).Sheets(1).UsedRange
                h = .Rows.Count - 3
                .Offset(2).Resize(h).Copy dest
                .Parent.Parent.Close
            End With
            dest(-1).Resize(, 2).Merge 'fusionne
            dest(-1) = Mid(f, InStrRev(f, "\") + 1)
            dest(0) = "Largeur Multi_profils"
            dest(0, 2) = "Hauteur Multi_profils"
            dest.Resize(h).TextToColumns dest, xlDelimited, Space:=True, DecimalSeparator:="."
            Set dest = dest(1, 3)
        End If
    Next
End With
Columns.AutoFit 'ajustement largeur
End Sub
A+
 

Pièces jointes

  • fichier_import(1).zip
    163.2 KB · Affichages: 23

herve62

XLDnaute Barbatruc
Supporter XLD
Bonjour
Jojo :
Voilà , j'ai passé un peu de temps ce WE pour te sortir cette appli en fonction de tes désidératas
sauf mauvaise compréhension de ma part.
-Tu peux choisir 1 ou x fichiers ( là max 10 mais modifiable) par répertoire choisi , ceux-ci se copieront les uns à côtés des autres par tranche de 2 colonnes automatiquement
- l'entête est indexé en fonction du Nom du fichier ( largeur ou hauteur & nom)
- l'entrée du répertoire est testée ; si erronée ou pas de .txt > erreur , recommencer ;Les Min Maj n'ont pas d'importance
Pour tester : tape le chemin du répertoire (ex c:\base\fichiers) après entrée les fichiers txt vont se lister , mettre la case de début (ex G2) valider , c'est terminé
Tout est facilement modifiable comme par exemple :
-raccourcir l'entrée si la base est par exemple toujours C:\DATA … , on peut mettre c:\DATA dans la variable et ne rentrer l'arborescence qu'à partir de là
- le nom des entêtes etc…
A toi de voir si cela rentre dans tes aspirations d'utilisation
 

Pièces jointes

  • importTXT_HD.xlsm
    454 KB · Affichages: 28

herve62

XLDnaute Barbatruc
Supporter XLD
Bonsoir
Si tous les txt dans un même dossier et de même structure et version Excel 2010 ou plus, faisable sans VBA avec POwerQuery (add on sur 2010 et 2013, intégré à 2016)
@chris
Curieux de nature , j'ai pas pu m'empêcher de le télécharger et de le tester , j'ai fait joujou 1h avec
principalement avec les fichiers de JOJO !!! pas évident de mettre en forme car il n'y a pas de " step by step" comme avec excel
Là il faut tatouiller un peu partout pour ajuster les colonnes, supprimer des lignes du haut , supprimer des colonnes etc ...; juste pour un fichier , tout ça pour avoir ERREUR au moment de charger !!!
Donc j'ai fait , testé , et donc peux en parler , peut-être pour des fichiers tout simple bien structuré ?, je n'en ai pas , donc pas testé!! , ni non plus avec la macro car faisable sans VBA !!
J'ai démonté !
 

chris

XLDnaute Barbatruc
Re

@herve62

Si si il y a du step par step : on travaille essentiellement via les menus
Les fonctions de découpage de chaîne sont bien plus sympas que celles d'Excel
On peut créer un traitement sur un exemple puis le transformer en fonction.
Ensuite on indique le dossier à traiter et la fonction à appliquer.

Mais c'est sûr que ce n'est pas forcément le cas par lequel commencer à s'initier à PowerQuery...
 

Discussions similaires

Réponses
10
Affichages
350
Réponses
13
Affichages
491

Statistiques des forums

Discussions
312 108
Messages
2 085 366
Membres
102 874
dernier inscrit
Petro2611