Décomposer fichier txt en plusieurs fichiers excel

Signaler
Messages postés
24
Date d'inscription
lundi 17 mai 2004
Statut
Membre
Dernière intervention
28 juin 2004
-
Messages postés
24
Date d'inscription
lundi 17 mai 2004
Statut
Membre
Dernière intervention
28 juin 2004
-
davidouz
je n'arrive pas à décomposer un "grand" fichier txt (800 colonnes) en plusieurs fichiers excel en répartissant les colonnes dans les différents fichiers. si possible, je souhaiterai une macro me permetant de le faire.
Pas si simple, non ?(j'ai pas access au boulot ...)

16 réponses

Messages postés
699
Date d'inscription
mercredi 19 février 2003
Statut
Membre
Dernière intervention
13 mai 2011
21
Bonjour,

comme j'ai vu que tout le monde séchait sur ta question, je t'ai fait ce petit code qui décompose un grand fichier texte (j'ai essayé avec un fichier de 800 colonnes et de 100 lignes) mais qui est très long.

En attendant que quelqu'un te trouve autre chose.

Par contre, j'ai mis comme délimiteur le point virgule, à toi de le changer s'il faut.

Sub ouvrirGrandFichier()

Dim feuille As Worksheet
Set feuille = Worksheets(1)
Dim cellule As Range
Set cellule = feuille.Range("a1")

Dim tableauLigne() As String
Dim ligneFichier As String

'les bornes limites pour les boucles
Dim compteur1, compteur2, reste As Integer

'le compteur pour le tableau
Dim cptTab As Integer

'les variables pour les boucles internes
Dim i, j As Integer

'Numéro libre pour l'ouverture du fichier
Dim numFichier As Integer
numFichier = FreeFile

'nombre de passage dans le fichier
Dim numeroLigne As Integer
numeroLigne = 1

Open ("D:\User\Tout\petitTexte.txt") For Input As #numFichier

While Not EOF(numFichier)
    Set feuille = Worksheets(1)
    Set cellule = feuille.Cells(numeroLigne, 1)
    Input #numFichier, ligneFichier

    tableauLigne = Split(ligneFichier, ";")

    cptTab = 0

    compteur1 = CInt((UBound(tableauLigne) + 1) / 256)
    compteur2 = 256
    reste = (UBound(tableauLigne) + 1) Mod 256

    If reste <> 0 Then compteur1 = compteur1 + 1

    'vérification du bon nombre de feuilles pour insérer l'ensemble des données
    Do Until Worksheets.Count = compteur1
        Worksheets.Add After:=Worksheets(Worksheets.Count)
    Loop

    For i = 0 To compteur1 - 1        If reste <> 0 And i compteur1 - 1 Then compteur2 reste
        For j = 0 To compteur2 - 1
            cellule.Offset(0, j).Value = tableauLigne(cptTab)
            cptTab = cptTab + 1
        Next j
    
    
        If cptTab <> UBound(tableauLigne) + 1 Then
            Set feuille = Worksheets(feuille.Index + 1)
            Set cellule = feuille.Cells(numeroLigne, 1)
        End If
    Next i

    numeroLigne = numeroLigne + 1

Wend
Close #numFichier
End Sub



Pour explication, le code lit ligne par ligne le fichier.
A chaque ligne,
- il met la ligne dans une variable tableau (avec le délimiteur)
- il décompose en divisant par 256 (nombre de colonnes d'exel),
- vérifie s'il y a le bon nombre de feuilles pour contenir toutes les données
- boucle sur les 256 et écris dans chaque cellule.

(en gros ça fait ça)

Fanny
Messages postés
24
Date d'inscription
lundi 17 mai 2004
Statut
Membre
Dernière intervention
28 juin 2004

davidouz

Olala merci bcp, je vais de suite essayer.
:)
que du bonheur MR VBA
Messages postés
699
Date d'inscription
mercredi 19 février 2003
Statut
Membre
Dernière intervention
13 mai 2011
21
Euh ...
MR VBA ?? C'est pour moi que tu dis ça ?? :shock)
Si oui, jusqu'à preuve du contraire je suis une fille lol >:)
;)

Dis moi si ça te convient.

Fanny
Messages postés
24
Date d'inscription
lundi 17 mai 2004
Statut
Membre
Dernière intervention
28 juin 2004

davidouz
AYE, ma version d'excel ne reconnait pas :
tableauLigne = Split(ligneFichier, ";")
SPLIT
Messages postés
24
Date d'inscription
lundi 17 mai 2004
Statut
Membre
Dernière intervention
28 juin 2004

davidouz
up'ss pardon ma cher fanny
Messages postés
699
Date d'inscription
mercredi 19 février 2003
Statut
Membre
Dernière intervention
13 mai 2011
21
Erf bon ben tant pis, je viens de recréer la fonction Split :big) :
(enfin, je l'ai renommé Decompose pour éviter les ennuis)

Function Decompose(ByVal chaine As String, ByVal delim As String) As String()
Dim tableau() As String
Dim indice As Integer
indice = 0
ReDim Preserve tableau(indice)

For i = 0 To Len(chaine)
    If Mid(chaine, i + 1, 1) = delim Then
        indice = indice + 1
        ReDim Preserve tableau(indice)
    Else
        tableau(indice) = tableau(indice) + Mid(chaine, i + 1, 1)
    End If

Next i
Decompose = tableau
End Function


Il te suffit de l'utiliser comme n'importe quelle fonction VB :
tableauLigne = Decompose(ligneFichier, ";")


Voilou voilou, ça devrait fonctionner.

Fanny
Messages postés
699
Date d'inscription
mercredi 19 février 2003
Statut
Membre
Dernière intervention
13 mai 2011
21
Oups, avec le mot Decompose ça ne marche pas chez moi, mais avec toto si :) .

Nommes la plutot :
Function SepareMots(.....) As String()

Fanny
Messages postés
24
Date d'inscription
lundi 17 mai 2004
Statut
Membre
Dernière intervention
28 juin 2004

davidouz

tableauLigne = Separemots(ligneFichier, ";")
il me dit "impossible d'affecter à une macro

De plus j'ai du enlever les parenthèse à la fin fin pr que la fonction soit reconnu :Function SepareMots(.....) As String
Messages postés
699
Date d'inscription
mercredi 19 février 2003
Statut
Membre
Dernière intervention
13 mai 2011
21
Aie donc pas bon ça.

Tu as bien mis la fonction juste après le code ?

Sub ouvrirGrandFichier()

Dim feuille As Worksheet
Set feuille = Worksheets(1)
Dim cellule As Range
Set cellule = feuille.Range("a1")

Dim tableauLigne() As String
Dim ligneFichier As String

'les bornes limites pour les boucles
Dim compteur1, compteur2, reste As Integer

'le compteur pour le tableau
Dim cptTab As Integer

'les variables pour les boucles internes
Dim i, j As Integer

'Numéro libre pour l'ouverture du fichier
Dim numFichier As Integer
numFichier = FreeFile

'nombre de passage dans le fichier
Dim numeroLigne As Integer
numeroLigne = 1

Open ("D:\User\Tout\petitTexte.txt") For Input As #numFichier

While Not EOF(numFichier)
    Set feuille = Worksheets(1)
    Set cellule = feuille.Cells(numeroLigne, 1)
    Input #numFichier, ligneFichier

    tableauLigne = SepareMots(ligneFichier, ";")

    cptTab = 0

    compteur1 = CInt((UBound(tableauLigne) + 1) / 256)
    compteur2 = 256
    reste = (UBound(tableauLigne) + 1) Mod 256

    If reste <> 0 Then compteur1 = compteur1 + 1

    'vérification du bon nombre de feuilles pour insérer l'ensemble des données
    Do Until Worksheets.Count = compteur1
        Worksheets.Add After:=Worksheets(Worksheets.Count)
    Loop

    For i = 0 To compteur1 - 1        If reste <> 0 And i compteur1 - 1 Then compteur2 reste
        For j = 0 To compteur2 - 1
            cellule.Offset(0, j).Value = tableauLigne(cptTab)
            cptTab = cptTab + 1
        Next j
    
    
        If cptTab <> UBound(tableauLigne) + 1 Then
            Set feuille = Worksheets(feuille.Index + 1)
            Set cellule = feuille.Cells(numeroLigne, 1)
        End If
    Next i

    numeroLigne = numeroLigne + 1

Wend

Close #numFichier

End Sub

Function SepareMots(ByVal chaine As String, ByVal delim As String) As String()
Dim tableau() As String
Dim indice, i As Integer
indice = 0
ReDim Preserve tableau(indice)

For i = 0 To Len(chaine)
    If Mid(chaine, i + 1, 1) = delim Then
        indice = indice + 1
        ReDim Preserve tableau(indice)
    Else
        tableau(indice) = tableau(indice) + Mid(chaine, i + 1, 1)
    End If

Next i
SepareMots = tableau
End Function



Sinon tant pis, intègre la fonction au code :
Option Explicit
Sub ouvrirGrandFichier()

Dim feuille As Worksheet
Set feuille = Worksheets(1)
Dim cellule As Range
Set cellule = feuille.Range("a1")

Dim tableauLigne() As String
Dim ligneFichier As String

'les bornes limites pour les boucles
Dim compteur1, compteur2, reste As Integer

'les compteurs pour les tableaux
Dim cptTab, indice As Integer

'les variables pour les boucles internes
Dim i, j As Integer

'Numéro libre pour l'ouverture du fichier
Dim numFichier As Integer
numFichier = FreeFile

'nombre de passage dans le fichier
Dim numeroLigne As Integer
numeroLigne = 1

Open ("D:\User\Tout\petitTexte.txt") For Input As #numFichier

While Not EOF(numFichier)
    Set feuille = Worksheets(1)
    Set cellule = feuille.Cells(numeroLigne, 1)
    Input #numFichier, ligneFichier

    'remplacement de la fonction split :
    indice = 0
    ReDim Preserve tableauLigne(indice)

    For i = 0 To Len(ligneFichier)
        If Mid(ligneFichier, i + 1, 1) = ";" Then
            indice = indice + 1
            ReDim Preserve tableauLigne(indice)
        Else
            tableauLigne(indice) = tableauLigne(indice) + Mid(ligneFichier, i + 1, 1)
        End If
    
    Next i
    
    cptTab = 0

    compteur1 = CInt((UBound(tableauLigne) + 1) / 256)
    compteur2 = 256
    reste = (UBound(tableauLigne) + 1) Mod 256

    If reste <> 0 Then compteur1 = compteur1 + 1

    'vérification du bon nombre de feuilles pour insérer l'ensemble des données
    Do Until Worksheets.Count = compteur1
        Worksheets.Add After:=Worksheets(Worksheets.Count)
    Loop

    For i = 0 To compteur1 - 1        If reste <> 0 And i compteur1 - 1 Then compteur2 reste
        For j = 0 To compteur2 - 1
            cellule.Offset(0, j).Value = tableauLigne(cptTab)
            cptTab = cptTab + 1
        Next j
    
    
        If cptTab <> UBound(tableauLigne) + 1 Then
            Set feuille = Worksheets(feuille.Index + 1)
            Set cellule = feuille.Cells(numeroLigne, 1)
        End If
    Next i

    numeroLigne = numeroLigne + 1

Wend

Close #numFichier

End Sub



Fanny
Messages postés
24
Date d'inscription
lundi 17 mai 2004
Statut
Membre
Dernière intervention
28 juin 2004

davidouz
LUT
petit pb il me marque indice en dehors de la plage pour:

tableauLigne(cptTab)

dans

For i = 0 To compteur1 - 1If reste <> 0 And i compteur1 - 1 Then compteur2 reste
For j = 0 To compteur2 - 1
cellule.Offset(0, j).Value = tableauLigne(cptTab)
cptTab = cptTab + 1
Next j
Messages postés
24
Date d'inscription
lundi 17 mai 2004
Statut
Membre
Dernière intervention
28 juin 2004

davidouz
LUT
petit pb il me marque indice en dehors de la plage pour:

tableauLigne(cptTab)

dans

For i = 0 To compteur1 - 1If reste <> 0 And i compteur1 - 1 Then compteur2 reste
For j = 0 To compteur2 - 1
cellule.Offset(0, j).Value = tableauLigne(cptTab)
cptTab = cptTab + 1
Next j
Messages postés
699
Date d'inscription
mercredi 19 février 2003
Statut
Membre
Dernière intervention
13 mai 2011
21
C'est bizarre parce que je viens de le réexécuter et moi je n'ai pas d'erreur ...

Tu as fait un copié-collé du code que j'ai écrit plus haut ?

Fanny
Messages postés
24
Date d'inscription
lundi 17 mai 2004
Statut
Membre
Dernière intervention
28 juin 2004

oui mais je pense que ça vient de la forme du fichier texte
impresionnant quand meme ton programme. merci pour le tps que ta passé
Messages postés
24
Date d'inscription
lundi 17 mai 2004
Statut
Membre
Dernière intervention
28 juin 2004

davidouz
ça me lit un chps de trop où il n'y a rien .il y a 415 champs et sur l'erreur ça m'affiche

cptTab=416

indice en dehors de la plage
Messages postés
699
Date d'inscription
mercredi 19 février 2003
Statut
Membre
Dernière intervention
13 mai 2011
21
Ton fichier texte a quelle forme ?

Moi je me suis créée, pour tester le code, un fichier avec le code suivant :

Sub remplirFichier()
'Numéro libre pour l'ouverture du fichier
Dim numFichier, i, j As Integer
numFichier = FreeFile

Dim chaine As String

Open ("D:\User\Tout\petitTexte.txt") For Output As #numFichier

For i = 1 To 100
    chaine = ""
    For j = 1 To 800
    chaine = chaine & "ligne " & i & ", colonne " & j & ";"
    Next j
Write #numFichier, Mid(chaine, 1, Len(chaine) - 1)
Next i

Close #numFichier

End Sub


Ce qui me donne 800 colonnes et 100 lignes.

S'il te met un champ de trop il faut que tu mettes un -1 quelque part, mais je ne vois pas où :sad) ...

Fanny
Messages postés
24
Date d'inscription
lundi 17 mai 2004
Statut
Membre
Dernière intervention
28 juin 2004

davidouz
je pourrais pas te l'envoyer?
Mon ad msn est davidouboss@hotmail.fr
ce soir si tu veux