XL 2016 Import Txt volumineux

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

auverland

XLDnaute Occasionnel
Bonjour le forum

J'ai parcouru le forum mais j'ai pas retrouvé le script qui permet l'importation de fichier txt volumineux sur plusieurs feuilles tout en gardant les entêtes sur chacune des feuilles. (séparateur ";")

Si vous aviez cela dans votre armoire je suis preneur
Bonne journée
 
Bonjour Auverland,
Qu'appelez vous volumineux ?
XL2016 possède 1 048 576 lignes et 16 384 colonnes sur une feuille. Votre fichier ne rentre pas dedans ?
Bonjour,

Mon fichier fait 171000Ko avec 10 variables (colonne)
Lorsque je l'importe il me met effectivement que je dépasse la capacité excel
J'avais vue une fois un script qui coupait le fichier en plusieurs feuille mais impossible de remettre la main dessus
 
Ouf ! J'espère que qulqu'un pourra vous aider, mais le problème est vraiment pointu.

J'ai trouvé cela qui fonctionnerais en adaptant le séparateur en ";"

VB:
Sub Extraction_V2()
Dim Repertoire As String, Fichier As String
Dim strFullName As Variant
Dim Cn As Object, Rs As Object
 
'Sélection du ficher
strFullName = Application.GetOpenFilename("Fichiers textes (*.txt),*.txt", , _
    "Sélectionnez un fichier :")
 
'On sort si aucun fichier n'est sélectionné
If strFullName = False Then Exit Sub
 
Application.ScreenUpdating = False
Fichier = Dir(strFullName)
Repertoire = Left(strFullName, Len(strFullName) - (Len(Fichier) + 1))
 
 
'Connection
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & ";" & _
    "Extended Properties=""text;HDR=Yes;FMT=Delimited"""
 
'Requete
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open "SELECT * FROM [" & Fichier & "]", Cn, 3, 1, 1
 
'boucle sur le résultat de la requete
While Not Rs.EOF
    'Ajout Feuille
    Worksheets.Add
    'Ecriture des données dans la feuille
    '65536 spécifie le nombre de lignes par feuille
    ActiveSheet.Range("A1").CopyFromRecordset Rs, 65536
Wend
 
Rs.Close
Set Rs = Nothing
Cn.Close
Set Cn = Nothing
Application.ScreenUpdating = True
End Sub
 
Bonjour

Un essais avec une macro que j'ai trouvé dans mes archives (limite à 65000 ligne)

VB:
Sub GrosFichierTXT()
Dim Ctr As Long, Ligne As String, Tablo, x As Integer
Application.ScreenUpdating = False
Ctr = 1
Open "D:\répertoire\sous-répertoire\fichier.txt" For Input As #1
Do While Not EOF(1)
If Ctr > 65000 Then
Ctr = 1
Sheets.Add
End If
Line Input #1, Ligne
Tablo = Split(Ligne, ";")
For x = 0 To UBound(Tablo)
Cells(Ctr, x + 1) = Tablo(x)
Next x
Ctr = Ctr + 1
Loop
Close #1
Application.ScreenUpdating = True
End Sub

Slts
 
Bonjour,

J'ai remis la main sur une procédure du grand Frédéric Sigonneau, adpatée d'un MVP dont j'ai oublié le nom !
ça donne ceci (à noter que le nombre maxi est à 65500, c'est dire si c'est ancien !!!)
'##############################
Sub ImportLargefile()
'Dimension Variables
Dim ResultStr As String
Dim FileName As String
Dim FileNum As Integer
Dim Counter As Double
FileName = "C:\Temp\yourfile.txt"
'If you want an inputbox use the below:
'InputBox("Write name of file and path")
If FileName = "" Then End
FileNum = FreeFile()
Open FileName For Input As #FileNum
Application.ScreenUpdating = False
Workbooks.Add template:=xlWorksheet
Counter = 1
Do While Seek(FileNum) <= LOF(FileNum)
Application.StatusBar = "Importerar Rad " & _
Counter & " Från TextFil " & FileName
Line Input #FileNum, ResultStr
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If
If ActiveCell.Row = 65500 Then
' I'll need some space below
'If file is larger than (Ce lien n'existe plus)
ActiveWorkbook.Sheets.Add
Else
ActiveCell.Offset(1, 0).Select
End If
Counter = Counter + 1
Loop
Close
Application.StatusBar = False
End Sub
'################################
En espérant que ça aide !

ThierryP
 
Bonjour auverland, le fil,

Le séparateur point-virgule c'est sur les fichiers CSV, les fichiers Texte (.txt) utilisent le caractère tabulation comme séparateur.

La lecture séquentielle d'un fichier texte et le transfert des données sont très rapides, voyez les fichiers joints et cette macro :
VB:
Sub Import()
Dim fichier$, nlig&, ncol%, w As Worksheet, a(), texte$, s, i&, j%, n&
fichier = ThisWorkbook.Path & "\Fichier Texte.txt" 'à adapter
nlig = 100 '1048576
ncol = 10 'nombre maximum de colonnes
'---suppression des feuilles---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In Worksheets
    If w.Index > 1 Then w.Delete
Next w
Worksheets(1).Cells.ClearContents 'RAZ
'---traitement séquentiel du fichier Texte et transferts---
ReDim a(1 To nlig, 1 To ncol)
Open fichier For Input As #1 'accès au fichier
Do While Not EOF(1) 'End Of File: fin du fichier
    Line Input #1, texte 'récupère la ligne
    s = Split(texte, vbTab) 'séparateur tabulation
    i = i + 1
    For j = 0 To UBound(s)
        a(i, j + 1) = s(j)
    Next j
    If i = nlig Then 'décharge
        If n Then Set w = Sheets.Add(After:=Sheets(Sheets.Count)) Else Set w = Worksheets(1)
        n = n + 1
        w.Name = "Import " & n
        w.Cells(1).Resize(nlig, ncol) = a
        w.Columns.AutoFit 'ajustement largeurs
        ReDim a(1 To nlig, 1 To ncol)
        i = 0
    End If
Loop
Close #1 'fermeture du fichier
'---dernier transfert
If i Then
    If n Then Set w = Sheets.Add(After:=Sheets(Sheets.Count)) Else Set w = Worksheets(1)
    n = n + 1
    w.Name = "Import " & n
    w.Cells(1).Resize(i, ncol) = a
    w.Columns.AutoFit 'ajustement largeurs
End If
Worksheets(1).Activate
End Sub
Bien entendu j'ai mis nlig = 100 pour tester, avec le très gros fichier on mettra nlig = 1048576.

A+
 

Pièces jointes

Bonjour auverland, le fil,

Le séparateur point-virgule c'est sur les fichiers CSV, les fichiers Texte (.txt) utilisent le caractère tabulation comme séparateur.

La lecture séquentielle d'un fichier texte et le transfert des données sont très rapides, voyez les fichiers joints et cette macro :

Bonsoir @job75

Mes fichiers sont en txt avec des séparateurs en point-virgule
Vue la taille des fichier je peux meme pas les remplacer
 
Bonjour auverland, le forum,

Si vous tenez au point-virgule comme séparateur dans le fichier Texte vous pouvez remplacer les tabulations avec cette macro :
VB:
Sub RemplacerTabulation()
Dim fichier$, texte$, a$(), i&
fichier = ThisWorkbook.Path & "\Fichier Texte.txt" 'à adapter
Open fichier For Input As #1 'accès au fichier en lecture
Do While Not EOF(1) 'End Of File: fin du fichier
    Line Input #1, texte 'récupère la ligne
    ReDim Preserve a(i)
    a(i) = Replace(texte, vbTab, ";")
    i = i + 1
Loop
Close #1
Open fichier For Output As #1 'accès au fichier en écriture
For i = 0 To UBound(a)
    Print #1, a(i)
Next
Close #1
End Sub
Ensuite bien sûr dans la macro Import remplacer vbTab par ";" :
VB:
s = Split(texte, ";") 'séparateur point-virgule
Bonne journée.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
12
Affichages
620
Réponses
7
Affichages
148
Réponses
5
Affichages
286
D
  • Question Question
2
Réponses
28
Affichages
2 K
Deleted member 441486
D
Réponses
2
Affichages
385
Retour