Import .txt en VBA problème de séparateur

Bonjour tout le monde,

jusqu’à présent j'ai toujours réussi à trouver ce qui faillait sur votre forum pour répondre à mes questions, hors là je bloque un peu. je voudrais importer plusieurs fichiers .txt en VBA dans plusieurs feuilles exel, mon problème sont les séparateurs, je vous joins le fichier pour vous montrer mon problème:

https://www.cjoint.com/doc/16_02/FBliwleP1Mq_combinaison1.txt

le code que j'utilise actuellement est celui ci, le problème est que le nombres d'espaces n'ai jamais constant dans le fichier :

Option Explicit

Const TypeFichier As String = "txt"
Const Separateur As String * 1 = " "

Sub DelFeuilles()
Dim i As Long
    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name <> ShParam.Name Then
            Application.DisplayAlerts = False
            Sheets(i).Delete
            Application.DisplayAlerts = True
        End If
    Next i
End Sub

Private Function Extension(sFichier As String) As String
Dim sExt As String
    sExt = Mid$(sFichier, InStrRev(sFichier, "." ) + 1)
    Extension = sExt
End Function

Private Sub Lire(ByVal sNomFichier As String)
Dim sChaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Ws As Worksheet

    Close

    NumFichier = FreeFile
    iRow = 1

    Open sNomFichier For Input As #NumFichier
    Set Ws = ThisWorkbook.Sheets.Add
    Ws.Move After:=Worksheets(Sheets.Count)
    Do While Not EOF(NumFichier)
        iCol = 1
        Line Input #NumFichier, sChaine
        Ar = Split(sChaine, Separateur)
        For i = LBound(Ar) To UBound(Ar)
            Ws.Cells(iRow, iCol) = Ar(i)
            iCol = iCol + 1
        Next i
        iRow = iRow + 1
    Loop
    Close #NumFichier
End Sub

Private Sub ListeFichiers(sDossier As String)
Dim sFichier As String, sChemin As String
Dim sExtension As String

    sFichier = Dir$(sDossier & "\*." & TypeFichier)
    Do While Len(sFichier) > 0
        sChemin = sDossier & "\" & sFichier
        sExtension = Extension(sChemin)
        If UCase$(sExtension) = UCase$(TypeFichier) Then
            Lire sChemin
        End If
        sFichier = Dir$()
    Loop
End Sub

Private Sub ListeFichiersRecur(sDossier As String, bRecur As Boolean)
Dim FSO As Object
Dim DossierSource As Object
Dim SousDossier As Object
Dim Fichier As Object

    Set FSO = CreateObject("Scripting.FileSystemObject" )
    Set DossierSource = FSO.GetFolder(sDossier)

    For Each Fichier In DossierSource.Files
        If UCase$(FSO.GetExtensionName(Fichier)) Like UCase$(TypeFichier) Then
            Lire Fichier
        End If
    Next Fichier

    If bRecur Then
        For Each SousDossier In DossierSource.SubFolders
            ListeFichiersRecur SousDossier.Path, True
        Next SousDossier
    End If

    Set DossierSource = Nothing
    Set FSO = Nothing
End Sub

Sub SelDossier()
Dim sChemin As String

    sChemin = ThisWorkbook.Path

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = sChemin & "\"
        .Title = "Sélectionner le Dossier"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Dossier"
        .Show
        If .SelectedItems.Count > 0 Then
            Application.ScreenUpdating = False
            ListeFichiers .SelectedItems(1)
            Application.ScreenUpdating = True
        End If
    End With
End Sub

Sub SelDossierRecur()
Dim sChemin As String

    sChemin = ThisWorkbook.Path

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = sChemin & "\"
        .Title = "Sélectionner le Dossier : Recherche Récursive"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Dossier"
        .Show
        If .SelectedItems.Count > 0 Then
            Application.ScreenUpdating = False
            ListeFichiersRecur .SelectedItems(1), True
            Application.ScreenUpdating = True
        End If
    End With
End Sub

Une "autre" méthode, éventuellement programmable mais simple à la main :

• tu changes l'extension de .txt en .csv
• tu l'ouvres avec excel
• tu fais Données > Convertir ... séparateur espace
• tu changes les . en ,

En VBA, tu ouvres chaque fichier texte, tu copies les données globalement dans chaque onglet, ensuite tu appliques la conversion et le changement des . en ,

je vais essayer sa tous de suite voir si cela convient avec ce que je veux faire,

Merci pour ta réponse.

En effet j'avais déjà utilisé cette méthode, en le faisant je me suis rappelé, le truc c'est que des fois j'ai beaucoup de fichier .txt a envoyer sous exel c'est pour cela que je voulais passer par le biais du VBA.

Je travaille dans un bureau d'étude les valeurs dans le tableau sont des calcules d'effort dans une structure acier, le premier numéro dans la colonnes que l'on pourrais appelé A, représente un élément de la structure, ensuite ce sont les efforts, je souhaite par la suite renseigner dans un autre onglet de mon exel, par exemple les poteaux sont renseignés de 40 a 90.

le but est de prendre toutes les valeurs qui dépassent un effort donnés et de les renseigner dans un autre onglet de cette feuille

En plus je ne m'y connais presque pas en VBA, je crois que j'ai encore pas mal de travail

ok pour aider, mais je ne sais pas quand ... je ne peux pas promettre un délai ferme.

donc si qqun a une peu de dispo pourquoi pas, sinon je t'envoie cela dès que j'ai terminé !

c'est avec un grand plaisir que je lis ton message , je vais aussi commencer des cours en VBA, pour mieux apprendre ce langage.

cela marche bien mais j'ai quand même un petit problème la colonne intitulée ELE (éléments) se décale d'une colonne sur la droite, je ne peux donc pas récupérer le numéro de la barre dans la colonne A.

En lisant tons code VBA je suis simplement comme sa

Encore un grand merci à toi de prendre le temps de répondre à mes questions, je suis des cours sur le VBA sur internet depuis ce matin 8h j'ai la tête qui va exploser

Pour les autres personnes qui pourraient suivre ce sujet, les fichiers .txt sont exporter du logiciel RDM6, qui est un freeware et permet de calculer les efforts dans les structures acier, bois, etc...

après avoir passé 3h sur ton code et compris qu'il faut jouer sur cette zone là:

Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, 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)), _
        TrailingMinusNumbers:=True

je n'ai pas réussi à avoir la première colonne, au moins j'ai compris a quoi servait chaque paramètre, j'ai essayer de tous les modifier avec ce site :

https://msdn.microsoft.com/fr-fr/library/office/ff837097.aspx

Mais en vain

c'est avec grande déception que je vais me coucher , je pensais y arriver tous seule vue que tu avais fait le plus dur.

Ce code-là, ce n'était pas bien compliqué car c'est fait avec l'enregistreur de macro.

je te joins le classeur avec la mise en forme "idéale"

j’avais aussi essayé avec l'enregistreur de macro qui me donne un code comme cela:

Sub Macro1()
'
' Macro1 Macro
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Bob\Desktop\Exel\Combinaison1.txt", Destination:=Range("$A$1") _
        )
        .CommandType = 0
        .Name = "Combinaison1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(4, 4, 10, 10, 10, 12)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

je te joint le classeur avec la mise en forme "idéal"

donc plus de problème ?

Si toujours... Je n'arrive pas à intégrer ce code dans celui que tu m'as donné. Celui-là je l'ai fait avec l'enregistreur de macro, puis -donnée/fichier texte, j'ai fait les manip et j'ai eu ce code.

Quand je modifie le code, je n'arrive pas à avoir la première ligne non plus. Comme je te disais : des fois j'ai 10, 20 ou 40 fichiers .txt à importer, les faire un par un c'est long >< C'est pour cela que je veux passer par le biais du VBA

Bonjour,

c'est bon je suis trop content j'ai enfin réussi.

j'ai fait quelques changements dans ton code et maintenant cela marche, j'ai quelque truc à rajouter aussi, comme supprimer les lignes de la colonne A, si elle est vide, mais ça c'est un autre sujet merci beaucoup à toi d'avoir pris de ton temps pour moi. je joins le code pour les personnes que cela intéresse:

Sub on_y_va()
    Dim Repertoire As FileDialog, monRepertoire As String
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
        monRepertoire = Repertoire.SelectedItems(1)
        aspirer monRepertoire
    Else
        MsgBox "Aucun Répertoire Sélectionné"
    End If
End Sub

Sub aspirer(ceRepertoire As String)

    Dim Fso, SourceFolder, SubFolder, fichier As Object
    Dim ws As Worksheet, wrecap As Worksheet

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(ceRepertoire)

    ' boucle sur tous les fichiers du répertoire
    For Each fichier In SourceFolder.Files
        If Right(fichier.Name, 4) = ".txt" Then
            ' création feuille
            If Not FeuilleExiste(ThisWorkbook, fichier.Name) Then
                Sheets.Add
                ActiveSheet.Name = fichier.Name
                Set ws = ActiveSheet
            Else
                Sheets(fichier.Name).Select
                Cells.Clear
                Set ws = ActiveSheet
            End If

            N = FreeFile
            Open fichier For Input As #N

            i = 0
            Do While Not EOF(1)
                Line Input #N, contenu
                i = i + 1
                Cells(i, 1).Value = contenu
            Loop

            Close #N

    ws.Select
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(8, 1), Array(18, 1), Array(28, 1), _
        Array(38, 1), Array(50, 1)), TrailingMinusNumbers:=True
    ActiveWindow.SmallScroll Down:=30
    Cells.Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        End If
    Next fichier

    ' appel récursif pour les sous-répertoires
    For Each SubFolder In SourceFolder.subfolders
        aspirer SubFolder.Path
    Next SubFolder

End Sub

Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
    On Error Resume Next
    FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function