XL 2013 VBA IMPORT .txt dans 5 lignes

[Hotburn]

Bonjour à tous,

Je viens rechercher de l'aide car j'ai une macro que j'ai réussi à bricoler en trouvant des infos sur le net (oui oui je suis un noob en VBA)

J'ai besoin d'importer mon fichier txt qui contient à chaque fois 5 lignes

Exemple .txt:

Valeur1
Valeur 2
Valeur 3
Valeur 4
Valeur 5

J'ai besoin de placer c'est valeur sur 5 lignes suite à suite.
Cependant ma macro me place les valeurs dans des colonnes

Sub importCSV()
Dim dialogBox As FileDialog
Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
Dim selectedFile As String

With dialogBox
.Filters.Add "TXT", "*.txt", 1
.AllowMultiSelect = False
If .Show = True Then
selectedFile = .SelectedItems(1)
End If
End With

If selectedFile <> "" Then
Open selectedFile For Input As #1
Dim rowNumber As Long
Dim lineFromFile As String
Dim lineItems As Variant 'array of string
Dim itteration As Integer
rowNumber = 1
Do Until EOF(1) 'false till end of file is reache then it will turn true
Line Input #1, lineFromFile 'inscrit la ligne du fichier 1 dans la valeur lineFromFile
lineItems = Split(lineFromFile, ";") 'séparateur
For itteration = 0 To 4
Range("ImportRange").Cells(rowNumber, itteration + 1) = lineItems(itteration)
Next
rowNumber = rowNumber + 1
Loop
Close #1
End If


End Sub

Es ce que quelqu'un aurait la sympathie de m'aider à comprendre?

En vous remerciant de la lecture de ce post.

Hotburn

 

[cp4]

Bonjour,

Je te propose le code que j'utilise. Je n'ai plus le lien du tuto.

Option Explicit
Dim ligne_debut As Integer, colonne_debut As Byte, ligne_enCours As Integer, colonne_enCours As Byte
 
Sub ChoixFichier()
   Dim Fichier As Variant
   Fichier = Application.GetOpenFilename("Tous les fichiers (*.csv),*.csv")
   If Fichier = False Then Exit Sub
   ligne_debut = 1: colonne_debut = 1
   ligne_enCours = ligne_debut: colonne_enCours = colonne_debut
   Feuil4.Cells.Clear 'feuille à adapter
   Lecture (Fichier)
End Sub

Sub Lecture(Fichier As String)
   Dim depart As Integer, position As Integer  'gerer position du ";" séparateur dans fichier csv
   Dim texte As String, tampon As Variant

   Open Fichier For Input As #1 'input acces au fichier
   Do While Not EOF(1) 'EndOfFile: fin du fichier
      Line Input #1, texte 'stocker ligne dans la variable texte
      depart = 1: position = 1 'initialisation variables
      Do While (position <> 0) 'parcourt des lignes pour trouver position du ";"
         position = InStr(depart, texte, ";", 1)
         If position = 0 Then 'si position=0, cela signifie fin de la ligne
            tampon = Mid(texte, depart)
            If IsNumeric(tampon) Then tampon = CDbl(tampon) 'conversion en nombre
            If IsDate(tampon) Then tampon = CDate(tampon) 'conversion en date
            Feuil2.Cells(ligne_enCours, colonne_enCours) = tampon
            Exit Do 'on sort de la boucle car on est en fin de ligne
         Else
            tampon = Mid(texte, depart, position - depart) 'si position<>0 signifie que ";" trouver
            If IsNumeric(tampon) Then tampon = CDbl(tampon) 'conversion en nombre
            If IsDate(tampon) Then tampon = CDate(tampon) 'conversion en date
         End If
         Feuil2.Cells(ligne_enCours, colonne_enCours) = tampon
         depart = position + 1
         colonne_enCours = colonne_enCours + 1
      Loop
      colonne_enCours = colonne_debut
      ligne_enCours = ligne_enCours + 1
   Loop
   Close #1 'fermeture du fichier pour décharger la mémoire
MsgBox "Import fichier CSV terminé!", vbInformation + vbOKOnly, "IMPORT CSV"
Feuil2.Activate 'feuille à adapter
End Sub

Pour éditer ton code dans les règles du forum démo ci-dessous


A+

 

[fanch55]

Bonjour,
Votre macro fait le travail pour lequel elle a été conçue :

• Lire un fichier texte.
• Pour chaque ligne lue :
  mettre les 5 valeurs séparées par ";" dans les 5 premières colonnes de la ligne de la rangée désignée.

Si vous changez la donne dans le fichier lu,
c'est sûr que la macro se plantera car elle est liée à un format fixe.

Pour faire un import quel que soit le nombre de "cellules" attendues, utilisez le code ci-dessous

Option Explicit
Sub Test()
    Cells.ClearContents
    importCSV
End Sub
Sub importCSV(Optional Start_Cell As Range)
Dim File As Object, Row As Long
Dim Line As Variant, Data As Variant

With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Clear
    .Filters.Add "TXT", "*.txt", 1
    .AllowMultiSelect = False
    If .Show = True Then
        Set File = CreateObject("Scripting.FileSystemObject").opentextfile(.SelectedItems(1))
            Data = Split(File.readall, vbNewLine)
            File.Close
        Set File = Nothing
        If Start_Cell Is Nothing Then Set Start_Cell = [A1]
        Row = Start_Cell.Row
        For Each Line In Data
            Line = Split(Line, ";")
            Rows(Row).Resize(, UBound(Line) + 1) = Line
            Row = Row + 1
        Next
    End If
End With
End Sub

 

[Hotburn]

Merci beaucoup. Ça fonctionne .
C’est vraiment sympa que les plus aguerris prennent du temps pour les autres.
Encore un grand merci.
Bon week end