Supprimer l'entête d'un fichier texte en VBA

**Etixnnx** · 03/08/2020, 15h40

Bonjour à tous,

Je dispose de 29 fichiers texte que j'ai au préalable compilé entre eux (à l'aide de VBA) pour n'en faire qu'un fichier texte (car c'est plus rapide pour mon analyse mais là n'est pas le problème).
Le problème est que le fichier compilé que je génère garde les entête de chacun des 29 fichiers et j'aimerais simplement supprimer les entêtes de colonnes pour juste laisser place aux données.

Quelqu'un aurait-t’il une suggestion à me proposer ? Merci d'avance

Voici mon code pour compiler les fichiers

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
 
 
Sub CompilationFichiersTexte_ADO()
    '
    'Ce programme génère un fichier txt qui compile tous les fichiers textes envoyés par Romain Valiente,
    'on peut ensuite donc utiliser le bouton maj_recap de Géraldine sur ce fichier pour récupérer toutes les données du 18/02/2019 au 30/05/2019
    'Nécessite d'activer la référence "Microsoft ActiveX Data Objects 2.0 Library : dispo dans outils : références"
    '
    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 = "N:\40 - Prévisions et Activité\01 - Météo\01 - Données Météo\Météo Réalisée\Données Réalisé feb-mai"
 
    'Ouvre un nouveau fichier Texte pour compiler les données
    '! ATTENTION à ne pas le placer dans le meme repertoire que les autres fichiers...
    Open "N:\40 - Prévisions et Activité\01 - Météo\01 - Données Météo\Météo Réalisée\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;
    'Pas d'entête à créer ici car on écrit à partir de la ligne 28000...
    '------------
 
        '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

Merci d'avance !

**Ben_L** · 03/08/2020, 16h19

Bonjour,

Je suppose que chaque fichier comporte une unique ligne d'entête. Si ça n'est pas le cas, il faudra adapter...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
            [...]
            Set Rc = New ADODB.Recordset
            Rc.Open Source:="SELECT * FROM [" & Fichier & "]", ActiveConnection:=cn
 
            Rc.MoveNext
 
            If Not Rc.EOF Then
                [...]

Idéalement, il faudrait bien sûr protéger la ligne ajoutée contre les éventuelles erreurs qui pourraient se produire.

Cdt

**Etixnnx** · 03/08/2020, 16h40

En effet chaque fichier est disposé en 1ère ligne avec les mêmes intitulés d'entêtes.
J'ai essayé ta méthode avec le MoveNext, mais le fichier compilé que je génère reste le même.

C'est bien cette ligne là que je veux supprimer, car MoveNext déplace simplement la position d'enregistrement non ?
Peut-être que le bug viendrait de la, il n'y a pas de méthode plus 'radical' en VBA du genre "EntireRow.Delete" de compatible avec les fichiers txt ?

**Ben_L** · 04/08/2020, 12h08

Oups, je n'avais pas fait attention au fait que vous appeliez les noms des champs plutôt que leur contenu...
Essayez avec le code modifié ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub CompilationFichiersTexte_ADO()
    '
    'Ce programme génère un fichier txt qui compile tous les fichiers textes envoyés par Romain Valiente,
    'on peut ensuite donc utiliser le bouton maj_recap de Géraldine sur ce fichier pour récupérer toutes les données du 18/02/2019 au 30/05/2019
    'Nécessite d'activer la référence "Microsoft ActiveX Data Objects 2.0 Library : dispo dans outils : références"
    '
    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 = "N:\40 - Prévisions et Activité\01 - Météo\01 - Données Météo\Météo Réalisée\Données Réalisé feb-mai"
 
    'Ouvre un nouveau fichier Texte pour compiler les données
    '! ATTENTION à ne pas le placer dans le meme repertoire que les autres fichiers...
    Open "N:\40 - Prévisions et Activité\01 - Météo\01 - Données Météo\Météo Réalisée\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;
    'Pas d'entête à créer ici car on écrit à partir de la ligne 28000...
    '------------
 
        '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
                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

**Etixnnx** · 04/08/2020, 13h12

Super merci Ben le fichier généré ne contient plus aucun entête c'est parfait !

**Etixnnx** · 04/08/2020, 13h50

D'ailleurs j'aurais une autre petite question...
Une fois que mes fichiers sont bien compilés et sans aucun entête (merci Ben), il me reste des lignes en double dans mon fichier car les 30 fichiers de base ont des lignes communes (au niveau du département et de la date),
j'aimerais donc avoir (toujours dans mon fichier txt compilé) un fichier qui ne contient plus aucun doublon (le département se situe en colonne A et la date du jour en colonne B).

Exemple :

13 ; 20190307 ; ......
13 ; 20190308 ; ......
~~13 ; 20190307 ; ......~~ Cette ligne est à supprimer car le département et la date sont similaires

Les "...." correspondent au reste des données de ma ligne (les doublons à partir de la colonne C ne pose aucun problème).
J'espère avoir été à peu près clair.

P.S : L'idéal est d'avoir tout le code (compilation + effacer doublons) dans le même programme.

Merci d'avance

**Ben_L** · 04/08/2020, 21h43

Assurer l'unicité une fois le fichier écrit va être lent et laborieux.
Il me semble donc préférable de procéder ligne par ligne et de vérifier si chacune doit être écrite ou non. Mais cela implique de modifier la façon d'accéder aux données (utiliser la propriété Fields.Item du RecordSet plutôt que GetString).
Une proposition de code plus bas.

Lorsque confronté à des problèmes d'unicité, j'ai généralement tendance à utiliser un dictionnaire.
Pour cela, il est nécessaire de référencer la librairie "Microsoft Scripting Runtime".
Il est possible d'ajouter des objets (ou des variables de base) dans un dictionnaire. L'objet Dictionary permet ensuite de vérifier l'existence d'un objet dans la liste des objets déjà ajoutés (via la propriété Exist).
Cela facilite grandement la vérification de l'unicité du couple département/date.

Ici, les objets stockés dans le dictionnaire sont des String correspondant aux lignes que l'on souhaite ajouter au fichier de synthèse.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub CompilationFichiersTexte_ADO()
    Dim Rc As ADODB.Recordset, Dict As New Scripting.Dictionary, i As Long, nFld As Long
    Dim cn As String, Chemin As String, Fichier As String, x As String, Uniq As String
 
    Chemin = "N:\40 - Prévisions et Activité\01 - Météo\01 - Données Météo\Météo Réalisée\Données Réalisé feb-mai"
    Open "N:\40 - Prévisions et Activité\01 - Météo\01 - Données Météo\Météo Réalisée\compilation.txt" For Output As #1
 
    Fichier = Dir(Chemin & "\*.txt")
    Do While Fichier <> ""
        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
 
        Do While Not Rc.EOF
            Uniq = ""
            For i = 0 To Rc.Fields.Count - 1
                Uniq = Uniq & Rc.Fields.Item(i).Value & ";"
            Next i
            If Dict.Exist(Uniq) Then Goto NextLine
 
            Dict.Add Uniq
            Print #1, Uniq & vbCrLf
 
NextLine:
            Rc.MoveNext
        Loop
 
        Rc.Close
        Fichier = Dir
    Loop
 
    Close #1
 
    MsgBox "Opération terminée"
End Sub

Je n'ai pas eu le temps de tester le code ci-dessus. Des erreurs sont possibles (voire probables...).

Pour l'instant, c'est l'intégralité de chaque ligne qui est utilisée pour déterminer l'unicité.
Il est possible de se limiter aux deux premiers champs si nécessaire.

Cdt

**Thumb down** · 05/08/2020, 00h04

bonsoir,
je ne suis pas certain d'avoir compris!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
        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
                    If x = "" Then
                        For i = 0 To Rc.Fields.Count - 1
                            x = x & Rc.Fields(i).Name & ";"
                        Next i
                        Print #1, Left(x, Len(x) - 1) & vbCrLf;
                    End If
                    '---
 
                Print #1, Rc.GetString(, , ";", vbCrLf, "");
            End If
 
            Rc.Close
            'x = ""
            '-------------------------
        Fichier = Dir
        Loop

**Pierre Fauconnier** · 05/08/2020, 08h45

Salut.

Perso, j'amènerais les fichiers texte dans Excel et je ferais les traitements dans Excel. Version 2010 taguée = possibilité d'utiliser Power Query => Pas de VBA ni pour la suppression des entêtes ni pour la suppression des doublons. Je sais que tu as demandé une solution VBA mais même en VBA sans PowerQuery, ça me semblerait plus simple de tout amener dans Excel, de faire le nettoyage et éventuellement de sauver en txt si besoin.

**Etixnnx** · 05/08/2020, 09h49

Merci à tous pour vos retours !
Je ne pourrai malheureusement pas avoir accès à mon fichier jusqu'à mardi prochain, je testerai toutes vos solutions et je vous retiendrai au courant sur le forum.
Merci encore,
Etienne

Supprimer l'entête d'un fichier texte en VBA [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager