Microsoft 365 Importer certaines données d'un ou plusieurs fichiers txt dans des cellules d'une feuille Excel

[FCMLE44]

Bonjour

J'ai un ou plusieurs fichiers txt dans un répertoire.
Je souhaiterais ouvrir ces fichier et récupérer certaines données pour les mettre dans une feuille d'un fichier excel
Je sais que ca peut se faire en créant une boucle mais je vous avoue que je sèche un peu n'ayant jamais travaillé avec des fichiers txt

Je vous mets un exemple excel en pièce jointe
Je dois remonter le numéro de Sécu, les noms et prénoms et le montant

Quelqu'un aurait il une idée ?

Merci

 

[chris]

Bonjour

Utiliser PowerQuery : c'est assez simple à faire

Peux-tu joindre 3 txt anonymisés (modifiés avec notepad afin de ne pas en modifier la structure)

 

[FCMLE44]

Les fichiers sont trés grand j'ai mis que la partie qui m'intéresse
Le nombre de lignes pourra varier

Merci

 

[chris]

RE

Tes fichiers sont pourris dès le départ où tu as travaillé comme un cochon en supprimant des retours à la ligne ?

Le montant c'est toujours Prestation complementaire ? Sinon il faudrait être plus précis...

Il y a toujours 3 personnes dans les txt ?

 

[FCMLE44]

non j ai supprimé avant et après
oui prestation complémentaire
et non il peut y avoir plus ou moins
merci

 

[chris]

RE

Donc dans les vrais fichiers il y a des lignes avec 2 infos par ligne comme

Monsieur HHHH KKKKK Arrêt de travail du 06/11/2020
Adhésion : 03468310 N°SS : 15????????

 

[FCMLE44]

oui ça peut arriver

 

[job75]

Bonsoir FCMLE44, chris,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Ouvrez le fichier .xlsm et exécutez la macro affectée au bouton :

Sub Importer()
Dim chemin$, fichier$, n%, a(), x%, texte$, p%
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.txt") '1er fichier txt du dossier
While fichier <> ""
    n = n + 1
    ReDim Preserve a(1 To 3, 1 To n)
    x = FreeFile
    Open chemin & fichier For Input As #x 'ouverture en lecture séquentielle
    Line Input #x, texte '1ère ligne
    p = InStr(texte, " ")
    a(2, n) = Mid(texte, p + 1)
    While Not EOF(x)
        Line Input #x, texte
        p = InStr(texte, "SS :")
        If p Then a(1, n) = Trim(Mid(texte, p + 4))
        If IsNumeric(texte) Then a(3, n) = CDbl(texte)
    Wend
    Close #x
    fichier = Dir 'fichier suivant
Wend
'---restitution---
With ActiveSheet 'à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A2]
        If n Then .Resize(n, 3) = Application.Transpose(a) 'fonction limitée à 65536 lignes
        .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
    End With
    .Columns.AutoFit 'ajustement largeurs
End With
End Sub

Bonne nuit.

 

[FCMLE44]

Bonsoir FCMLE44, chris,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Ouvrez le fichier .xlsm et exécutez la macro affectée au bouton :

Sub Importer()
Dim chemin$, fichier$, n%, a(), x%, texte$, p%
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.txt") '1er fichier txt du dossier
While fichier <> ""
    n = n + 1
    ReDim Preserve a(1 To 3, 1 To n)
    x = FreeFile
    Open chemin & fichier For Input As #x 'ouverture en lecture séquentielle
    Line Input #x, texte '1ère ligne
    p = InStr(texte, " ")
    a(2, n) = Mid(texte, p + 1)
    While Not EOF(x)
        Line Input #x, texte
        p = InStr(texte, "SS :")
        If p Then a(1, n) = Trim(Mid(texte, p + 4))
        If IsNumeric(texte) Then a(3, n) = CDbl(texte)
    Wend
    Close #x
    fichier = Dir 'fichier suivant
Wend
'---restitution---
With ActiveSheet 'à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A2]
        If n Then .Resize(n, 3) = Application.Transpose(a) 'fonction limitée à 65536 lignes
        .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
    End With
    .Columns.AutoFit 'ajustement largeurs
End With
End Sub

Bonne nuit.

Merci ca fonctionne mais uniquement avec ces fichiers pour lequel j'ai supprimé des lignes par confidentialitéet je peux avoir plétore de fichier du même genre

 

[FCMLE44]

RE

Donc dans les vrais fichiers il y a des lignes avec 2 infos par ligne comme

Monsieur HHHH KKKKK Arrêt de travail du 06/11/2020
Adhésion : 03468310 N°SS : 15????????

Bonjour
As tu pu réusssir avec Power Query ? Si oui je suis preneur de l'explication
Encore merci

 

[job75]

Bonjour,

Merci ca fonctionne mais uniquement avec ces fichiers pour lequel j'ai supprimé des lignes par confidentialitéet je peux avoir plétore de fichier du même genre

C'est pourtant clair : tous les fichiers .txt situés dans le même dossier sont traités par la macro.

A+

 

[chris]

Bonjour à tous

As tu pu réusssir avec Power Query ? Si oui je suis preneur de l'explication
Encore merci

Dans la mesure où sur une même ligne on a plusieurs infos mais que manifestement tes 3 fichiers sont le même bricolé donc pas vraiment représentatif, j'attendais d'avoir un peu plus d'infos que tes réponses sibyllines...

Pour l'instant j'ai cela, si on part du principe qu'on ne restitue que les lignes avec montant

 

[FCMLE44]

Bonjour à tous



Dans la mesure où sur une même ligne on a plusieurs infos mais que manifestement tes 3 fichiers sont le même bricolé donc pas vraiment représentatif, j'attendais d'avoir un peu plus d'infos que tes réponses sibyllines...

Pour l'instant j'ai cela

Regarde la pièce jointe 1147513

Le truc c'est que dans les fichiers réels et globaux il y a énormément de lignes avec plusieurs indivdus
En tout cas semble etre celui que je souhaite

 

[chris]

RE
Le problème n'est pas le nombre d'individus mais les cas de lignes portant plusieurs infos

Ici on 2 cas

• Nom avec information Arrêt de travail
• Adhésion avec N°SS

Cela laisse supposer d'autres cas et il faut donc une analyse précise des cas...

 

[job75]

Bon j'ai mieux regardé vos fichiers, testez ce fichier (2) avec cette macro :

Option Compare Text 'la casse est ignorée

Sub Importer()
Dim chemin$, fichier$, x%, montant As Boolean, texte$, civ, p%, n&, a(), deb%, fin%
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.txt") '1er fichier txt du dossier
While fichier <> ""
    x = FreeFile
    Open chemin & fichier For Input As #x 'ouverture en lecture séquentielle
    montant = False
    While Not EOF(x)
        Line Input #x, texte
        texte = Replace(Replace(Replace(texte, "é", "é"), "è", "è"), "ê", "ê") 'épuration
        '---récupération du Montant à passer---
        If montant Then montant = False: If IsNumeric(texte) Then a(4, n) = CDbl(texte)
        '---nom---
        For Each civ In Array("Monsieur", "Madame", "Mademoiselle")
            p = InStr(texte, civ)
            If p Then
                n = n + 1
                ReDim Preserve a(1 To 4, 1 To n)
                a(1, n) = fichier
                deb = p + Len(civ)
                fin = InStr(texte, "Arrêt")
                If fin Then fin = fin - 1 Else fin = Len(texte)
                a(3, n) = Trim(Mid(texte, deb, fin - deb + 1))
                Exit For
            End If
        Next
        '---N°SS---
        p = InStr(texte, "SS :")
        If p Then
            deb = p + 4
            fin = Len(texte)
            a(2, n) = Trim(Mid(texte, deb, fin - deb + 1))
        End If
        '---Montant à passer---
        If texte = "Prestation complementaire" Then montant = True 'repérage
    Wend
    Close #x
    fichier = Dir 'fichier suivant
Wend
'---restitution---
With ActiveSheet 'à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A2]
        If n Then .Resize(n, 4) = Application.Transpose(a) 'fonction limitée à 65536 lignes
        .Offset(n).Resize(Rows.Count - n - .Row + 1, 4).ClearContents 'RAZ en dessous
    End With
    .Columns.AutoFit 'ajustement largeurs
End With
End Sub