Transformation données d'un fichier Txt en Excel

[ted1057]

Bonjour à la communauté.

Je travaille actuellement sur la conversion d'un fichier Txt en En fichier Excel.
Le fichier Txt provient d'un logiciel interne à ma société. Il sert à effectuer un débit de profils pour l'assemblage d'une menuiserie. Il n'est pas possible d'utiliser d'autre système de débit car le logiciel donne également la liste de quincaillerie nécessaire pour l'assemblage de la menuiserie.

Mon objectif est d'insérer le fichier txt sous Excel et d'en définir une liste de débit selon l'exemple en pièce jointe.
La problématique c'est quand insérant le fichier txt, sous Excel, les espacements ne sont pas identiques et il est donc pas possible d'utiliser les séparateurs.

Si quelqu'un pouvait me donner des pistes de réflexions, code VBA, source...

Merci par avance

 

[Boo2bafoot]

Bonjour ted,

Une macro permettant d'ouvrir ton fichier .txt et de le formater comme il faut doit être jouable.
Peux-tu poster un de tes fichiers txt pour regarder un peu mieux?

 

[ted1057]

Bonjour ted,

Une macro permettant d'ouvrir ton fichier .txt et de le formater comme il faut doit être jouable.
Peux-tu poster un de tes fichiers txt pour regarder un peu mieux?

Je regarde pour mettre cela, il suffit juste que je change le nom des produits. Sur les lignes ou il n'y a pas de longueur en mm, il s'agit d'un besoin en quantité, il s'agit de quincaillerie, accessoires.

 

[jp14]

Bonjour

Ci dessous une procédure qui devrait répondre au problème.

Il faut corriger le texte suivant
1 x 1096 mReste : 111 mm. La procédure utilise les "mm" comme séparateur.
1 x 1096 mm Reste : 111 mm.

A tester

Sub travdem()
Dim Cellule1 As Range, Plg1 As Range, pos As Integer, Data As String, I1 As Integer
Dim Nomfeuille1 As String, Col1 As String

'parametre
Col1 = "A"
'code
With Sheets(ActiveSheet.Name)
'réorganisation du texte
For Each Cellule1 In .Range(Col1 & "74:" & Col1 & .Range(Col1 & .Rows.Count).End(xlUp).Row)
If Cellule1 <> "" Then
If InStr(1, Cellule1, "Reste") = 0 Then
Cellule1 = Cellule1 & " " & Cellule1.Offset(1, 0)
Cellule1.Offset(1, 0) = ""
End If
End If
Next Cellule1
' suppression des espaces
For Each Cellule1 In .Range(Col1 & "74:" & Col1 & .Range(Col1 & .Rows.Count).End(xlUp).Row)
If Cellule1 <> "" Then
Do
If InStr(1, Cellule1, " ") > 0 Then
Cellule1 = Replace(Cellule1, " ", " ")
Else
Exit Do
End If
Loop
End If

Next Cellule1

For Each Cellule1 In .Range(Col1 & "74:" & Col1 & .Range(Col1 & .Rows.Count).End(xlUp).Row)
Data = Cellule1
If Data <> "" Then
pos = InStr(1, Data, ":")
If pos > 0 Then
Cellule1.Offset(0, 5) = Trim(Mid(Data, 1, pos - 1))
Data = Trim(Mid(Data, pos + 1))
End If
I1 = 6
Do
If InStr(1, Data, "mm") > 0 Then
pos = InStr(1, Data, "mm")
Cellule1.Offset(0, I1) = Trim(Mid(Data, 1, pos + 2))
Data = Trim(Mid(Data, pos + 2))
I1 = I1 + 1
Else
Exit Do
End If
Loop

End If
Next Cellule1

End With
End Sub


Bonne journée

JP14

 

[ted1057]

Bonjour JP14,

Merci pour ta réponse rapide.
J'ai l'impression que la macro reste bloquée sur la première partie de la macro. Elle n'arrive pas à sortir de la boucle loop j'ai l'impression.
La deuxième partie fonctionne sans doute mais impossible de tester. La deuxième partie exécute la séparation des données réalisée par la première phase de la macro?

 

[jp14]

Bonjour (Re)

Attention il y a deux espaces pour le code suivant :

If InStr(1, Cellule1, " 2 espaces ") > 0 Then ' on sort de la boucle Do quand il n'y a plus d'espace double
Cellule1 = Replace(Cellule1, "2 espaces ", " ") ligne pour supprimer les espaces inutiles

JP14

 

[ted1057]

Merci bien JP14, le programme fonctionne bien. Je vais regarder pour le finaliser de façon à ce qu'il me transcrive les données dans mon tableau final. Tu m'as fait gagné un temps précieux.
Merci grandement,
J'essaierais de montrer le programme fini

Cordialement,