Les meilleurs sources pour ExcelConsultez toutes les FAQ

Nombre d'auteurs : 10, nombre de questions : 65, dernière mise à jour : 8 février 2020 

 
OuvrirSommaireLes fichiers texte
Vba
Sélectionnez
Option Explicit

Const ForReading = 1
Const ForWriting = 2


Sub SupprimetTexteEndouble()
    
    'Nécessite d'activer la référence "Microsoft Scripting Run Time"
    
    Dim oDict As Scripting.Dictionary
    Dim oFSO As Scripting.FileSystemObject
    Dim oFile As Scripting.TextStream
    Dim maCle 'As ????????????????
    Dim strName As String, Fichier As String
    
    Fichier = "C:\NomFichier.txt"
    
    
    Set oDict = CreateObject("Scripting.Dictionary")
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.OpenTextFile(Fichier, ForReading)
    
    '--- Récupère les données sans doublon ---
    Do Until oFile.AtEndOfStream
        strName = oFile.ReadLine
        If Not oDict.Exists(strName) Then oDict.Add strName, strName
    Loop
    
    oFile.Close
    '-----------------------------------------
    
    
    Set oFile = oFSO.OpenTextFile(Fichier, ForWriting)
    'Retransfère les données sans doublons dans le fichier txt
    For Each maCle In oDict.Keys
        oFile.WriteLine maCle
    Next
    
    oFile.Close
End Sub
Créé le 17 juin 2007  par SilkyRoad

Cet exemple boucle sur tous les fichiers txt d'un répertoire et regroupe les données, à la suite, dans une feuille de calcul.
La procédure utilise la propriété QueryTables.

Vba
Sélectionnez
Sub Test()
    Dim Fichier As String, Chemin As String
    Dim i As Long
    
    'Répertoire contenant les fichiers
    Chemin = "C:\Documents and Settings\mimi\dossier\general\excel"
    Fichier = Dir(Chemin & "\*.txt")
    
    'Boucle sur les fichiers
    Do While Fichier <> ""
        
        i = Range("A65536").End(xlUp).Row + 1
        ImportText Chemin & "\" & Fichier, Cells(i, 1)
        
        Fichier = Dir
    Loop
End Sub
Vba
Sélectionnez
Sub ImportText(NomFichier As Variant, Cible As Range)
    Dim QT As QueryTable
    
    Set QT = ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
        NomFichier, Destination:=Cible)
    
    With QT
        'Définit les séparateur de colonnes dans le fichier txt
        .TextFileOtherDelimiter = ";"
        .TextFileSemicolonDelimiter = True
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .Refresh
    End With
End Sub
Créé le 17 juin 2007  par SilkyRoad

La procédure boucle sur tous les fichiers txt d'un répertoire et regroupe leur contenu dans un nouveau fichier texte. Dans cet exemple, chaque fichier contient des données sur 2 colonnes, dont le séparateur est le point virgule (;).

Important: le fichier de compilation ne doit pas être dans le même répertoire que les autres fichiers txt.


Nécessite d'activer la référence "Microsoft ActiveX Data Objects 2.x Library".

Vba
Sélectionnez
Sub CompilationFichiersTexte_ADO()
'
'Nécessite d'activer la référence
'"Microsoft ActiveX Data Objects 2.x Library"
'
Dim Rc As ADODB.Recordset
Dim cn As String, Chemin As String, Fichier As String, x As String
Dim i As Long
    
'répertoire contenant les fichiers texte
Chemin = "C:\Repertoire"
    
'Ouvre un nouveau fichier Texte pour compiler les données
'! attention à ne pas le placer dans le meme repertoire que les autres fichiers...
Open "C:\Compilation.txt" For Output As #1

'--- Création d'un entête: adaptez cette ligne en fonction du nombre
'de colonnes dans les fichiers (2 colonnes dans cet exemple):
Print #1, "Champ1;Champ2" & vbCrLf;
'------------
        
    'boucle sur l'ensemble des fichiers txt
    Fichier = Dir(Chemin & "\*.txt")
    Do While Fichier <> ""
        
        '----- requète pour récupérer le contenu du fichier txt
        cn = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
        "Dbq=" & Chemin & ";Extensions=asc,csv,tab,txt"
        
        Set Rc = New ADODB.Recordset
        Rc.Open Source:="SELECT * FROM [" & Fichier & "]", ActiveConnection:=cn
        
        If Not Rc.EOF Then
                
                '--- recuperation de la première ligne
                For i = 0 To Rc.Fields.Count - 1
                x = x & Rc.Fields(i).Name & ";"
                Next i
                Print #1, Left(x, Len(x) - 1) & vbCrLf;
                '---
            
            Print #1, Rc.GetString(, , ";", vbCrLf, "");
        End If
        
        Rc.Close
        x = ""
        '-------------------------
    Fichier = Dir
    Loop
    
'Fermeture du fichier Compilation
Close #1

MsgBox "Opération terminée"
End Sub




L'option suivante permet ensuite d'appliquer un tri sur la première colonne du fichier compilation:

Vba
Sélectionnez
Sub TriFichierTXT_ADO()
'
'Nécessite d'activer la référence
'"Microsoft ActiveX Data Object 2.x Library'
'
    Dim Rc As ADODB.Recordset
    Dim cn As String, Chemin As String, Fichier As String
    Dim i As Long
    Dim x As String
    
'Ouvre un nouveau fichier Texte pour compiler les données triée
Open "C:\CompilationTriee.txt" For Output As #1
    
    'Le fichier que vous souhaitez trier:
    Chemin = "C:\"
    Fichier = "Compilation.txt"
    
    cn = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
    "Dbq=" & Chemin & ";Extensions=asc,csv,tab,txt"
    
    Set Rc = New ADODB.Recordset
    Rc.Open Source:="SELECT * FROM " & Fichier & _
                " ORDER BY Champ1", ActiveConnection:=cn
    
    If Not Rc.EOF Then
                
                '--- récupération de la première ligne
                For i = 0 To Rc.Fields.Count - 1
                x = x & Rc.Fields(i).Name & ";"
                Next i
                Print #1, Left(x, Len(x) - 1) & vbCrLf;
                '---
    
    Print #1, Rc.GetString(, , ";", vbCrLf, "");
    End If
    
    Rc.Close
    Set Rc = Nothing

'Fermeture du fichier CompilationTriee
Close #1

MsgBox "Opération terminée"
End Sub
Créé le 17 juin 2007  par SilkyRoad
  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2007 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.