[Excel VB] Extraction texte dans une cellule

Résolu
Kauracks -  
 Kauracks -
Bonjour,

J'ai une fichier .txt qui ressemble à ça :

06 07 10 16 03 43,890 -0,5304 -0,0381 -0,0098
06 07 10 16 03 45,890 -0,4627 -0,0196 -0,0196
06 07 10 16 03 47,921 -0,2750 -0,0392 -0,0196
06 07 10 16 03 49,921 -0,3241 -0,0054 -0,0196
06 07 10 16 03 51,921 -0,3754 -0,0392 -0,0295

Se que je voudrais faire c'est un macro qui ouvre une boite de dialogue qui me laisse chercher l'emplacement du .txt, pis qui l'extrait dans une cellule déjà défini et qu'elle soit splitter avec les espaces.

Cependant j'arrive que à obtenir une macro où le nom et l'emplacement du fichier doit être identique, pas possibilité de mettre un aut' nom ou à un autre endroit donc.

Quelqu'un aurait une solution ?

4 réponses

  1. Kauracks
     
    Sub Macro2()
    
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;G:\depression.txt", _
            Destination:=Range("$A$1"))
            .Name = "depression musee"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    End Sub


    Voilà la macro (oui j'avoue j'ai juste fait un "enregistrer une macro" ^_^)

    J'ai essayé de placer un "Application.GetOpenFilename" à la place du chemin d'accès mais pas moyen de faire marcher.
    0
  2. Kauracks
     
    Merci beaucoup !

    Par contre il y juste encore un petit problème... dans le fichier Txt, il y a certain nombre comme 0,94 ou 0,078 ors ces nombres sont "stockés sous forme des textes" dans les cellules et je ne peux donc elles font merdé les formules.

    Lorsque que je fais "Enregistrer maccro" et que je clique sur "Convertir en nombre" dans le code VB, il n'y a que le "Select XX".

    J'ai un peu chercher sur le net pour trouver une solution. Une solution proposé est de remplacer les points par des virgules mais lorsque que je regarde les valeurs des cellules c'est bien des virgules donc je sais plus trop quoi faire.

    Si quelqu'un a une solution
    0
    1. Kauracks
       
      C'est bon, j'ai trouver la solution

      Il sufiit d'utilisé la formule "=CNUM(cellule)"
      0
  3. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Bonjour,
    Tu peu montrer la macros en question ?
    A+
    -1
  4. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Une autre méthode ?
    A coller dans un module...
    Option Explicit
    
    Public Chemin As String
    Public Fichier As String
    Public FichierCour As String
    Public FichPath As String
    
    'Sélectionner un fichier par boite de dialogue
    Function SelectionFichier() As Boolean
    Dim i As Integer
        FichPath = Application.GetOpenFilename(FileFilter:="(*.*),*.tous" _
                , Title:="Sélectionnez le fichier à convertir")
        If FichPath = "Faux" Then 'pas de sélection faite
            Exit Function
        End If
        For i = Len(FichPath) To 2 Step -1
            If Mid(FichPath, i, 1) = "\" Then Exit For
        Next i
        Chemin = Left(FichPath, i)
        Fichier = Mid(FichPath, i + 1)
        FichierCour = Left(Fichier, Len(Fichier) - 4)
        SelectionFichier = True
    End Function
    
    Sub ConvertirTxt()
    Dim Fichier As String, L As Long, TB, i As Integer
    Dim LigDetination As Integer
    Dim ColDetination As Integer
    Dim Wk As Workbook
        Set Wk = ThisWorkbook
            LigDetination = ActiveCell.Row 'Adapter la cellule de destination
            ColDetination = ActiveCell.Column 'Adapter la cellule de destination
        If SelectionFichier Then
            Workbooks.Open Filename:=FichPath
            For L = 1 To Range("A65535").End(xlUp).Row
                TB = Split(Cells(L, 1), " ")
                With Wk.ActiveSheet
                    For i = 0 To UBound(TB)
                        .Cells(LigDetination + L - 1, ColDetination + i) = TB(i)
                    Next i
                End With
            Next L
            Workbooks(FichierCour).Close
        Else
            Exit Sub
        End If
    End Sub

    Mettre le curseur dans la sub ConvertirTxt et taper F5
    A+
    -1
    1. Kauracks
       
      Encore une question...

      Quand j'exécute ta macro je rencontre un problème, je ne peux pas déterminer la cellule cible.

      En effet, les espions sur Ligdetination & ColDetination m'indique bien un valeur différente de 1:1. Pourtant l'extraction se fait toujours à ce point.

      Avec Exécution Pas à Pas, on voit que à la ligne "Workbooks.Open Filename:=FichPath" l'extraction est faite et donc qu'elle ne prend pas en compte les deux variables de la cellule.

      Existe-t-il un autre fonction pour permettre ceci ou est-ce qu'il manque un variable ?
      0