[Excel VB] Extraction texte dans une cellule

Résolu/Fermé
Signaler
-
 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

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.
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
C'est bon, j'ai trouver la solution

Il sufiit d'utilisé la formule "=CNUM(cellule)"
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
Bonjour,
Tu peu montrer la macros en question ?
A+
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
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+
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 ?