FAQ Excel
FAQ ExcelConsultez toutes les FAQ
Nombre d'auteurs : 46, nombre de questions : 845, dernière mise à jour : 30 mars 2022
- Comment importer dans Excel des fichiers txt contenant plus de 65 536 lignes ?
- Comment importer un fichier txt dans la feuille de calcul via le modèle ADO ?
- Comment transférer le contenu d'une feuille d'un classeur fermé vers un fichier texte ?
- Comment supprimer quelques lignes discontinues dans un fichier texte ?
- Comment récupérer des informations dans un fichier dont les enregistrements sont délimités par groupes d'octets ?
- Comment récupérer le contenu d'un fichier txt placé sur internet ?
Cette solution scinde le fichier txt en 65 536 lignes par feuille.
65 536 correspond au nombre de lignes importées par feuille. Au delà de cette valeur, une nouvelle feuille est
ajoutée et le compteur est réinitialisé.
vbTab (tabulation) est supposé être le séparateur de données pour les éléments de chaque ligne.
Sub
Test
(
)
Extraction "C:\dossier\Nomfichier.txt"
, 65536
, vbTab
End
Sub
Sub
Extraction
(
Fichier As
String
, _
NbLignesParFeuille As
Long
, _
Separateur As
Variant
)
Dim
Wb As
Workbook
Dim
Counter As
Double
Dim
Tableau
(
) As
String
Dim
i As
Integer
Dim
ContenuLigne As
String
Application.ScreenUpdating
=
False
Counter =
1
Set
Wb =
Workbooks.Add
(
1
)
'Ouverture du fichier txt
Open Fichier For
Input As
#1
Do
While
Not
EOF
(
1
)
If
Counter >
NbLignesParFeuille Then
Wb.Worksheets.Add
Counter =
1
End
If
Line Input #1
, ContenuLigne
'découpe la chaine en fonction des espaces " "
'le résultat de la fonction Split est stocké dans un tableau
Tableau =
Split
(
ContenuLigne, Separateur)
'boucle sur le tableau pour extraire les données
For
i =
0
To
UBound
(
Tableau)
ActiveSheet.Cells
(
Counter, i +
1
) =
Tableau
(
i)
Next
i
Counter =
Counter +
1
Loop
Close #1
Application.ScreenUpdating
=
True
MsgBox
"Opération terminée"
End
Sub
Une autre solution qui utilise le paramètre MaxRows de la méthode CopyFromRecordset afin de définir le nombre de lignes par feuille, lors de l'import.
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
Sub
importFichierTexte_ADO
(
)
Dim
Rc As
ADODB.Recordset
Dim
cn As
String
, Chemin As
String
, Fichier As
String
Dim
i As
Long
Chemin =
"C:\Documents and Settings\michel\dossier"
Fichier =
"monFichier.txt"
cn =
"Driver={Microsoft Text Driver (*.txt; *.csv)};"
&
_
"Dbq="
&
Chemin &
";Extensions=asc,csv,tab,txt"
Set
Rc =
New
ADODB.Recordset
Rc.Open
Source:=
"SELECT * FROM "
&
Fichier &
_
" WHERE NomChamp = 'x'"
, ActiveConnection:=
cn
If
Not
Rc.EOF
Then
'For i = 0 To Rc.Fields.Count - 1 'recuperation entetes
'Cells(1, 1).Offset(0, i) = Rc.Fields(i).Name
'Next
Range
(
"A2"
).CopyFromRecordset
Rc
End
If
Rc.Close
End
Sub
La solution proposée ici utilise la méthode GetString.
Rs.GetString
(
adClipString, -
1
, ";"
, vbCrLf
, ""
)
adClipString indique le format de la requête (choix unique).-
1
indique qu'il faut récupérer tous les enregistrements.";"
spécifie le délimiteur de colonnes.vbCrLf
spécifie le délimiteur d'enregistrements.""
indique comment doivent être représentées les valeurs nulles.
Sub
FeuilleExcel_VersFichierTexte
(
)
'Nécessite d'activer la référence
'Microsoft ActiveX Data Objects 2.x Library
Dim
Rs As
ADODB.Recordset
Dim
Fichier As
String
, Feuille As
String
Dim
xConnect As
String
, xSql As
String
Dim
i As
Long
Dim
x As
String
Fichier =
"C:\dossier\ClasseurFerme.xls"
Feuille =
"Feuil1"
xConnect =
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
&
_
Fichier &
";"
&
_
"Extended Properties=Excel 8.0;"
xSql =
"SELECT * FROM ["
&
Feuille &
"$];"
Set
Rs =
New
ADODB.Recordset
Rs.Open
xSql, xConnect, adOpenForwardOnly
, adLockReadOnly
, adCmdText
'--- récupération de la première ligne
For
i =
0
To
Rs.Fields.Count
-
1
x =
x &
Rs.Fields
(
i).Name
&
";"
Next
i
'---
'Création du fichier txt.
'Si le fichier existe, les anciennes données seront écrasées.
'Si le fichier n'existe pas , il sera créé automatiquement.
Open "C:\essai.txt"
For
Output As
#1
'Ecriture de l'entête dans le fichier .txt
Print #1
, Left
(
x, Len
(
x) -
1
) &
vbCrLf
;
'Ecriture de la requête dans le fichier .txt
Print #1
, Rs.GetString
(
adClipString, -
1
, ";"
, vbCrLf
, ""
)
Close #1
Rs.Close
Set
Rs =
Nothing
End
Sub
Cet exemple supprime les lignes 1, 3 et 10.
Les numéros de lignes doivent impérativement être spécifiés par ordre décroissant.
Option
Explicit
Option
Base 1
Sub
SuppressionLignes
(
)
Dim
objCol As
New
Collection
Dim
x As
Integer
, i As
Integer
Dim
strLigne As
String
, Fichier As
String
Dim
Tableau As
Variant
'Définit les lignes à supprimer, par
'ordre décroissant impérativement !
Tableau =
Array
(
10
, 3
, 1
)
Fichier =
"C:\monFichier.txt"
x =
FreeFile
'Transfère des infos du fichier txt vers une collection.
Open Fichier For
Input As
#x
While
Not
EOF
(
x)
Line Input #x, strLigne
objCol.Add
strLigne
Wend
Close #x
'Suppression des lignes spécifiées dans la collection.
For
i =
1
To
UBound
(
Tableau)
If
objCol.Count
>=
Tableau
(
i) Then
_
objCol.Remove
Tableau
(
i)
Next
i
'Transfère la collection vers le fichier txt.
Open Fichier For
Output As
#x
For
i =
1
To
objCol.Count
Print #x, objCol
(
i)
Next
Close #x
Set
objCol =
Nothing
End
Sub
Ouvrez votre fichier en mode binaire.
Par exemple, sur une base de 128 octects par groupe, vous pouvez utiliser :
Dim
lngPosistion As
Long
Dim
strLine As
String
Open "C:\dossier\test.txt"
For
Binary As
#1
Do
While
lngPosistion <
LOF
(
1
)
strLine =
Input
(
128
, #1
)
lngPosistion =
Loc
(
1
)
Debug.Print
strLine
Loop
Close #1
La première solution consiste à importer le fichier sur votre disque pour ensuite l'ouvrir.
Private
Declare
Function
URLDownloadToFile Lib
"urlmon"
Alias _
"URLDownloadToFileA"
(
ByVal
pCaller As
Long
, ByVal
szURL As
String
, _
ByVal
szFileName As
String
, ByVal
dwReserved As
Long
, _
ByVal
lpfnCB As
Long
) As
Long
Sub
Telechargement
(
)
URLDownloadToFile 0
, "http://www.passiblog.com/404.txt"
, "C:\404.txt"
&
ufile, 0
, 0
End
Sub
La deuxième solution lit le fichier directement puis le charge dans un buffer texte :
Option
Explicit
Const
scUserAgent =
""
Const
INTERNET_OPEN_TYPE_DIRECT =
1
Const
INTERNET_OPEN_TYPE_PROXY =
3
Const
INTERNET_FLAG_RELOAD =
&
H80000000
Private
Declare
Function
InternetOpen Lib
"wininet"
Alias "InternetOpenA"
_
(
ByVal
sAgent As
String
, ByVal
lAccessType As
Long
, ByVal
sProxyName As
String
, _
ByVal
sProxyBypass As
String
, ByVal
lFlags As
Long
) As
Long
Private
Declare
Function
InternetCloseHandle Lib
"wininet"
_
(
ByVal
hInet As
Long
) As
Integer
Private
Declare
Function
InternetReadFile Lib
"wininet"
_
(
ByVal
hFile As
Long
, ByVal
sBuffer As
String
, ByVal
lNumBytesToRead As
Long
, _
lNumberOfBytesRead As
Long
) As
Integer
Private
Declare
Function
InternetOpenUrl Lib
"wininet"
Alias "InternetOpenUrlA"
_
(
ByVal
hInternetSession As
Long
, ByVal
lpszUrl As
String
, _
ByVal
lpszHeaders As
String
, ByVal
dwHeadersLength As
Long
, ByVal
dwFlags As
Long
, _
ByVal
dwContext As
Long
) As
Long
Sub
Test
(
)
Dim
hOpen As
Long
, hFile As
Long
Dim
sBuffer As
String
Dim
hRet As
Long
'Create a buffer for the file we're going to download
sBuffer =
Space
(
20000
)
'Create an internet connection
hOpen =
InternetOpen
(
scUserAgent, INTERNET_OPEN_TYPE_DIRECT, _
vbNullString
, vbNullString
, 0
)
'Open the url
hFile =
InternetOpenUrl
(
hOpen, "http://www.passiblog.com/404.txt"
, _
vbNullString
, ByVal
0
&
, INTERNET_FLAG_RELOAD, ByVal
0
&
)
'Lit le fichier > buffer
InternetReadFile hFile, sBuffer, Len
(
sBuffer), hRet
'clean up
InternetCloseHandle hFile
InternetCloseHandle hOpen
'-- recupère la chaine lue
Contents =
Trim
(
sBuffer)
Debug.Print
Contents
End
Sub