Concaténation de fichiers

**Jay29** · 21/09/2009, 14h53

Bonjour à tous,
Je dois concaténer 2 fichiers .txt puis les convertir en .xls l'un à la suite de l'autre. Pour cela j'ai crée le code 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
Dim Rg As Range, K As Long
Dim Nb As Long, Fichier As String
Dim Ligne As String, C, X As Integer
Nb = FreeFile
 
Set Rg = ThisWorkbook.Worksheets("Feuil1").Range("A1")
 
For a = 1 To 2 ' 2 pour 2 fichiers
'Indique le chemin et le nom du fichier de chacun
nom = Application.GetOpenFilename("Nom fichier,*.txt")
Fichier = Choose(a, nom, nom)
Open Fichier For Input As Nb
Do While Not EOF(Nb)
Line Input #Nb, Ligne
'Remplacer VbTab par le séparateur
'des fichiers texte ("," par exemple)
C = Split(Ligne, ",")
Rg.Offset(K).Resize(, UBound(C) + 1) = C
K = K + 1
Loop
Close #Nb
Next
End Sub

Cependant il faut que je rajoute un critère pour la séparation des colonnes qui correspond a ça quand je fait un enregistrement manuel de la conversion :

Code :

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

1
2
3
4
5
6
7
8
9
nom = Application.GetOpenFilename("Nom fichier,*.txt")
Workbooks.OpenText nom, _
        Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
        , Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
        Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1)), TrailingMinusNumbers:=True

Le critère a ajouter est

Code :

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

TextQualifier:= _ xlDoubleQuote,

mais je n'arrive pas a l'insérer dans mon code. Merci d'avance pour votre aide.

**Fvandermeulen** · 21/09/2009, 15h26

Salut,
Essaies (moi j'ai pas testé) en modifiant la ligne:

Code :

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

C = Split(Ligne, ",")

Par:

Code :

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

C = Split(Ligne, ";")

Ou alors supprime cette même ligne et place celle-ci après 'Close #nb'

Code :

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

1
2
    Sheets("Feuil1").Columns("A").TextToColumns DataType:=xlDelimited, _
    semicolon:=True

Je crois que ce sera plus rapide à l'exécution

A+

**Jay29** · 21/09/2009, 15h48

Tout d'abord merci pour ton aide.
Alors j'ai essayé de supprimer la ligne avec le Split et de la remplacer avec celle que tu m'as donné cependant ca ne fonctionne pas il me dit "Erreur exécution '13' : Incompatibilité de type" pour la ligne :

Code :

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

Rg.Offset(K).Resize(, UBound(C) + 1) = C

Pour ce qui est de ta proposition de changer la "," par un ";" ce n'est pas possible car la virgule est le bon critère de séparation des colonnes mais je voudrais rajouter en plus un autre critère que je ne sais pas comment interpréter avec du code VBA. J'ai fait un screenshot et l'ai mis en pièce jointe.

**Fvandermeulen** · 21/09/2009, 16h30

Re,
Désolé pour le ',' et ';' j'ai pas été attentif, c'est par habitude du ';'

L'erreur est "normale" cette ligne se réfère à C (je suis vraiment pas au point aujourd'hui

) donc supprime cette ligne aussi

Code :

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

Rg.Offset(K).Resize(, UBound(C) + 1) = C

Et en mettant cette ligne ci alors, les " étant les doublequote

Code :

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

    Sheets("Feuil1").Columns("A").TextToColumns DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, semicolon:=True

A+

**Jay29** · 21/09/2009, 16h44

Re,

J'ai fait comme tu me l'as dit cependant j'ai toujours une erreur et cette fois ci sur la ligne que tu m'as donné. Il me dit "Erreur d'éxécution '1004' : Erreur définie par l'application ou l'objet".
Merci beaucoup pour ton aide.

**Fvandermeulen** · 21/09/2009, 16h50

Salut,
Ce numéro d'erreur me fait penser que le nom de la feuille n'est pas correct, vérifie bien.

A toute fin utile, voici un code que j'utilise pour récupérer des fichiers Txt de plus de 65000 lignes, il devrait fonctionner tel quel chez toi, la différence est qu'il crée autant de feuille que nécessaire et les renomme en DataX, DataY,...
Le mieux serait que tu crées un nouveau classeur avec une seule feuille nommées Parametres et place ce code dedans.

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
Sub ImportTxtNew()
Dim ligne As String, strFullName, i As Long, NbWs As Long
 
Deb = Now()
 
    Worksheets.Add
    strFullName = Application.GetOpenFilename("Fichiers textes (*.txt),*.txt", , _
    "Sélectionnez un fichier :")
 
    Open strFullName For Input As #1
 
    Do While Not EOF(1)
            Do While (Not EOF(1)) And (i < 65500)
                i = i + 1
                Input #1, ligne
                Cells(i, 1).Value = ligne
            Loop
        If i < 65500 Or EOF(1) Then Exit Do
            i = 0
            Worksheets.Add
    Loop
    Close #1
 
'Renomme les feuilles avec les données
NbWs = Worksheets.Count
For i = 1 To NbWs - 1
    If Sheets(i).Name = "Parametres" Then Resume Next
    Sheets(i).Columns("A").TextToColumns DataType:=xlDelimited, _
    semicolon:=True
    Sheets(i).Name = "Data " & i
Next i
 
End Sub

A+

**Jay29** · 21/09/2009, 17h03

Ton code fonctionne cependant ce n'est pas ce que cherche à faire mais merci quand même de me l'avoir proposé. Malheureusement il ne formate pas mon fichier .txt comme je le voudrais. N'y a-t-il pas un moyen d'ajouter ce paramètre avec la fonction Split ??? Car avec mon code de départ, ça fonctionnait bien mais il me manquait juste a ajouter les Doublequote en paramètre.

**Fvandermeulen** · 21/09/2009, 17h07

Re,
J'utilise pas Split, donc je t'avoue qu'il faudrait que je cherche un peu par contre je vois que j'ai oublié d'adapter une ligne de mon code avec le DoubleQuote pour qu'il fonctionne chez toi, on dira que c'est parce que c'est lundi

Réessaies ceci, désolé:

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
Sub ImportTxtNew()
Dim ligne As String, strFullName, i As Long, NbWs As Long
 
Deb = Now()
 
    Worksheets.Add
    strFullName = Application.GetOpenFilename("Fichiers textes (*.txt),*.txt", , _
    "Sélectionnez un fichier :")
 
    Open strFullName For Input As #1
 
    Do While Not EOF(1)
            Do While (Not EOF(1)) And (i < 65500)
                i = i + 1
                Input #1, ligne
                Cells(i, 1).Value = ligne
            Loop
        If i < 65500 Or EOF(1) Then Exit Do
            i = 0
            Worksheets.Add
    Loop
    Close #1
 
'Renomme les feuilles avec les données
NbWs = Worksheets.Count
For i = 1 To NbWs - 1
    If Sheets(i).Name = "Parametres" Then Resume Next
    Sheets(i).Columns("A").TextToColumns DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, semicolon:=True    Sheets(i).Name = "Data " & i
Next i
 
End Sub

**Jay29** · 21/09/2009, 17h18

Je suis vraiment désolé mais ca ne fonctionne toujours pas

.
En fait, en exécutant ton code mes données se mettent les une en dessous de l'autre (voir screen1). Alors que je voudrais qu'il se formate comme sur le screen2.

**Fvandermeulen** · 21/09/2009, 17h27

Si il n'y a rien de confidentiel, peux tu mettre un bout du fichier text en pièce jointe ?

**Jay29** · 21/09/2009, 17h59

Non bien sûr. Voici un petit bout.

**kiki29** · 21/09/2009, 22h12

Salut, à adapter pour l'eventualité d'un nombre de ligne > 65536 sinon devrait marcher

PS : après test subsiste le problème de virgules "parasites" dans certaines lignes , par exemple :
"Azurfloor, liste des tailles / / "
"Dessableur dégraisseur rectangulaire type V , rampes de vibrair / / "
qui entraine un décalage des données

**Jay29** · 22/09/2009, 09h36

Salut

Effectivement il y a bien un décalage !!!

Merci quand même pour ta proposition !!!

**kiki29** · 22/09/2009, 19h06

Salut, ajout d'un bouton de Correction qui supprime les virgules surnuméraires qui décalaient les données, donc lancer d'abord Correction puis Lecture sur ces fichiers "corrigés" renommés en Corr_xyz.txt, à toi de tester

**Jay29** · 23/09/2009, 09h18

Salut!

Merci beaucoup pour ton code il fonctionne bien !!!
Je t'en demande beaucoup mais tu crois qu'il serait possible d'ouvrir 2 fichiers .txt et qu'ils soient l'un à la suite de l'autre. Avec la macro actuelle, lorsque j'ouvre un 2eme fichier .txt il me remplace le contenu.

Merci à toi !

**kiki29** · 23/09/2009, 11h01

Salut, tu peux sélectionner x fichiers : maintenir la touche Ctrl enfoncée et cliquer sur les fichiers que tu veux Corriger ou Lire, ou les "englober" à la souris
avec la touche Ctrl enfoncée en recliquant sur un fichier sélectionné tu le désélectionnes.

De plus tu peux maintenant tout faire en une passe en affectant un bouton à

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
Sub UnePasse()
Dim FD As FileDialog
Dim i As Integer
Dim sNomFichier2 As String, sCheminFichier As String
 
    ChDir ThisWorkbook.Path
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    With FD
        .Filters.Clear
        .Filters.Add "Fichiers texte (*.txt)", "*.txt"
        .InitialFileName = "*.txt"
        .AllowMultiSelect = True
        .ButtonName = "Sélection fichier(s)"
        .Title = "Sélectionner un ou plusieurs fichier(s)"
    End With
 
    If FD.Show = True Then
        iRow = 0
        Application.ScreenUpdating = False
        ShTst.Cells.Clear
 
        For i = 1 To FD.SelectedItems.Count
            Correction FD.SelectedItems(i)
        Next i
 
        LireEntete FD.SelectedItems(1)
        For i = 1 To FD.SelectedItems.Count
            sCheminFichier = Chemin(FD.SelectedItems(i))
            sNomFichier2 = sCheminFichier & "Corr_" & NomDuFichier(FD.SelectedItems(i))
            Lire sNomFichier2
        Next i
 
        Application.ScreenUpdating = True
    End If
 
    Set FD = Nothing
End Sub