Importation texte placé entre des caractères définis

Bonjour le forum

J'utilise une macro qui me récupère dans plusieurs fichiers txt des bouts de données situés sur la même ligne que des textes définis.

Exemple:

Je veux récupérer dans tous les fichiers txt la date de l'essai.

Les fichiers texte se présentent ainsi:

"Date de l'Essai","09/02/2012","3"

La macro récupère :

","09/02/2012","3"

Ensuite je suis obligé de "nettoyer" le résultat avec des bouts de code pour ne retrouver que 09/02/2012.

Celà fonctionne mais cela alourdi pas mal la macro.

Existe il un moyen de récupérer les données situées entre les deux "," tout en conservant le lien avec les textes définis.

Je n'arrive pas à le faire.

Dans le fichier zippé il y a un classeur excel avec la macro dans le module 1 ainsi qu'un des fichiers texte.

Je vous remercie pour toute aide.

salut

j'ai pas télécharger tes pièces jointes, j'ai placé "Date de l'Essai","09/02/2012","3" en cellule A1 et écrit le code ci-dessous pour extraire la date, ca te va ?

t = Range("a1")
t1 = Mid(Split(t, ",")(1), 2, 10)

MsgBox t1'pour controle

a plus

Bonjour à tous

Bonjour Hervé.

D'abord un grand merci pour l'attention que tu portes à mon problème.

Je commence par rattraper un oubli sur mon premier post.

La macro qui est intégrée au classeur joint ma été aimablement fournie par l'excellent h2s04 dans le post ci-dessous.

https://forum.excel-pratique.com/excel/recuperation-textes-definis-t48677.html

J'espère qu'il me pardonnera de na pas l'avoir cité de suite.

Pour en revenir à mon souci, je pense que le bout de code que tu m'a fourni hervé pourra m'être utile dans la partie "nettoyage de la macro (là où je supprime les caractères inutiles).

En fait il faudrait que ton bout de code puisse être intégré directement dans le code qui récupère les diverses données pour éviter de faire le nettoyage une fois les données inscrites dans la feuille excel.

Voilà ci-dessous le code complet que j'utilise (recherche des données + nettoyage des caractères en trop):

Option Explicit
Sub test()

Dim temps As String
Dim entete
Dim Feuil2 As Object
Dim dernière_colonne As String
Dim Chemin As String
Dim S As String
Dim s1 As String
Dim fichier As String
Dim ligne As String
Dim tablo As String
Dim i As Integer
Dim paramètre As String
Dim contenu_cellule As String
Dim objShell As Object
Dim objFolder As Object
Dim trouvé As Boolean

Dim vTa, vTb, z&

 Application.ScreenUpdating = False

' Résultat feuille avec paramètres et résultats
      Set Feuil2 = Worksheets("Feuil2")

'chemin= emplacement où chercher les fichiers
'Ouvre l'explorateur windows pour rechercher les fichiers
      Chemin = Application.GetOpenFilename("Text Files (*.3R_RESULTAT), *.3R_RESULTAT")
      Chemin = Dir(Chemin & "*.3R_RESULTAT")

      temps = Timer

'Inscrit en entête de colonne les paramètres recherchés
      With Sheets("Feuil2").Select
      entete = Array("Date de l'Essai", "Heure de l'Essai", "Résistance théorique", "Contrôleur", _
      "Pince Testée", "N° de la pince", "pérateur", "Section du câble", "Réglage de la pince", "Force Maxi")
      Range("A1:J1") = entete

' dernière_colonne = dernière colonne utlisée dans Feuil1 en partant de la colonne ZA1
      dernière_colonne = Feuil2.Range("ZA1").End(xlToLeft).Column
      Set objShell = CreateObject("Shell.Application")

' fichier contient le nom du premier fichier correspondant au filtre
      fichier = Dir(Chemin)

' ligne = pointeur de ligne en cours sur Feul1
'ligne = 1 correspond aux entêtes
      ligne = 1

 'tant qu'il y a un fichier
      While fichier <> ""
      trouvé = False
 ' on ouvre le fichier
      Open Chemin & fichier For Input As #1

' on charge le contenu du fichier dans un tablo
      While Not EOF(1)
      Line Input #1, tablo

 ' on parcourt tous les paramètres
      For i = 1 To dernière_colonne

 ' paramètre est le paramètre en cours
      paramètre = Feuil2.Cells(1, i)

 ' on cherche les paramètres dans le tablo
      S = InStr(UCase(tablo), UCase(paramètre))

 ' on a trouvé un paramètre dans le tablo
 ' contenu_cellule est le contenu inscrit dans les cellules de Feuil1
 ' conformément ausx paramètres recherchés (entêtes)
      If S <> 0 Then
      If trouvé = False Then trouvé = True: ligne = ligne + 1
      contenu_cellule = Mid(tablo, S + Len(paramètre))

 ' on met contenu_cellule dans Feuil1 après l'avoir "nettoyé"
      Feuil2.Cells(ligne, i) = Application.WorksheetFunction.Clean(Trim(Replace(Replace(contenu_cellule, "=", ""), ";", "")))
      contenu_cellule = ""
      Exit For
      End If
      Next i
      Wend
      Close 1

 ' on prend le fichier suivant qui correspond au filtre
      fichier = Dir()
      Wend
      Set Feuil2 = Nothing

'Déplacement de la colonne Résistance théorique à côté de Force maxi
      vTa = Array(3)
      vTb = Array(10)
      For z = LBound(vTa) To UBound(vTa)
      Columns(vTa(z)).Cut
      Columns(vTb(z)).Insert Shift:=xlToRight
      Next

'Suppression des caractères en trop
       Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        OtherChar:="""", FieldInfo:=Array(Array(0, 9), Array(3, 4), Array(13, 9)), _
        TrailingMinusNumbers:=True

    Columns("B:B").Select
    Selection.Replace What:=""",""", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="4""", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Columns("F:F").Select
    Selection.Replace What:="échantillon", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Range("C:C,D:D,E:E,F:F,G:G,I:I").Select
    Range("I1").Activate
    Selection.Replace What:=""",""", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="1""", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Columns("G:G").Select
    Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True

    Columns("H:H").Select
    Selection.Replace What:=""",""", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="1""", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Columns("J:J").Select
    Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="""", FieldInfo:=Array(Array(1, 9), Array(2, 9), Array(3, 2), Array(4, 9), Array(5 _
    , 9), Array(6, 1)), TrailingMinusNumbers:=True
    Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True

'Efface la première ligne
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp

'Tri ascendant de la colonne A avec B (Date / heure)
   Sheets("Feuil2").[A1].Sort Key1:=Sheets("Feuil2").[A1], Order1:=xlAscending, _
       key2:=Sheets("Feuil2").[B1], Order2:=xlAscending, Header:=xlGuess

'Copie le tableau dans la feuille Résultats à la suite des autres
    Range("A1:J" & Range("A65536").End(xlUp).Row).Copy _
    Sheets("Résultats").Range("A65536").End(xlUp)(2)

'Efface les cellules en Feuil2
    Cells.Delete Shift:=xlUp

 End With

'Sélectionne la feuille Résultats
 Sheets("Résultats").Select

 'Quadrillage du tableau actif
    Range("A2").Select
    Selection.CurrentRegion.Select
    With Selection.Borders
    .Weight = xlThin
    End With

'Colore en rouge le résultat qui est < à la valeur théorique
For i = Range("J" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("J" & i).Offset(, -1) > Range("J" & i) Then
       Cells(i, 10).Interior.ColorIndex = 3
        End If
    Next

'Colore en orange le résultat qui est = à la valeur théorique
For i = Range("J" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("J" & i).Offset(, -1) = Range("J" & i) Then
       Cells(i, 10).Interior.ColorIndex = 45
        End If
    Next

  MsgBox Timer - temps

End Sub

Je vais essayer d'intégrer ton code

Merci encore

Bonne journée à tous

Bonjour à tous

j'ai un peu avancé sur mon problème.

J'ai modifié le "nettoyage" effectué lors de l'importation des données:

Clean(Trim(Replace(Replace(contenu_cellule, "=", ""), ";", "")))

devient:

 Clean(Trim(Replace(contenu_cellule, """,""", " ")))

Du coup toujours avec l'exemple de la date je passe de

"Date de l'Essai","09/02/2012","3"

à

09/02/2012 3"

C'est déjà mieux mais il me reste toujours deux caractères parasites dans toutes les colonne (1" ou 2" ou 3" ou 4")

A suivre!!!

Bonjour le forum

Je reviens à la charge avec mon problème.

quelqu'un a il une idée pour modifier ce bout de code:

 Clean(Trim(Replace(contenu_cellule, """,""", " ")))

Afin que seules les données entre deux "," soit conservées.

Merci

Pas d'idées.

Bonne soirée

Bonjour

J'ai trouvé une solution en rajoutant un bout de code:

Feuil2.Cells(Ligne, i) = Replace((contenu_cellule), """,""", "")
      Cells(Ligne, i) = Left(Cells(Ligne, i), Len(Cells(Ligne, i)) - 2)

Mes données récupérées sont maintenant nettoyées.

Bonne soirée à tous