Macro pour délimiter
- Initiateur de la discussion hamza00
- Date de début
Re : Macro pour délimiter
Sub LargeFileImport()
' Dimension Variables.
Dim ResultStr As String
Dim FileName As Variant
Dim FileNum As Integer
Dim Counter As Double
' Ask User for file's name.
FileName = Application.GetOpenFilename("TEXT")
' Check for no entry.
If FileName = False Then End
' Get next available file handle number.
FileNum = FreeFile()
' Open text file for input.
Open FileName For Input As #FileNum
' Turn screen updating off.
Application.ScreenUpdating = False
' Create a new workbook with one worksheet in it.
Workbooks.Add template:=xlWorksheet
Counter = 1
' Loop until the end of file is reached.
Do While Seek(FileNum) <= LOF(FileNum)
' Display importing row number on status bar.
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & FileName
' Store one line of text from file to variable.
Line Input #FileNum, ResultStr
' Store variable data into active cell.
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If
If ActiveCell.Row = 65536 Then
' If on the last row then add a new sheet.
ActiveWorkbook.Sheets.Add
Else
' If not the last row then go one cell down.
ActiveCell.Offset(1, 0).Select
End If
' Increment the counter by 1.
Counter = Counter + 1
' Start again at top of 'do while' statement.
Loop
' Close the open text file.
Close
' Remove message from status bar.
Application.StatusBar = False
End Sub
merci bcp mais il me dit Erreur d'exécution 1004
Erreur définie par l'application ou par l'objet
Sub LargeFileImport()
' Dimension Variables.
Dim ResultStr As String
Dim FileName As Variant
Dim FileNum As Integer
Dim Counter As Double
' Ask User for file's name.
FileName = Application.GetOpenFilename("TEXT")
' Check for no entry.
If FileName = False Then End
' Get next available file handle number.
FileNum = FreeFile()
' Open text file for input.
Open FileName For Input As #FileNum
' Turn screen updating off.
Application.ScreenUpdating = False
' Create a new workbook with one worksheet in it.
Workbooks.Add template:=xlWorksheet
Counter = 1
' Loop until the end of file is reached.
Do While Seek(FileNum) <= LOF(FileNum)
' Display importing row number on status bar.
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & FileName
' Store one line of text from file to variable.
Line Input #FileNum, ResultStr
' Store variable data into active cell.
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If
If ActiveCell.Row = 65536 Then
' If on the last row then add a new sheet.
ActiveWorkbook.Sheets.Add
Else
' If not the last row then go one cell down.
ActiveCell.Offset(1, 0).Select
End If
' Increment the counter by 1.
Counter = Counter + 1
' Start again at top of 'do while' statement.
Loop
' Close the open text file.
Close
' Remove message from status bar.
Application.StatusBar = False
End Sub
merci bcp mais il me dit Erreur d'exécution 1004
Erreur définie par l'application ou par l'objet
G
Guest
Guest
Re : Macro pour délimiter
Bonjour,
Je vais répéter ce que te disais JC:
sinon on va tourner en rond.
Quand tu donnes une erreur, essaie de nous dire sur quelle ligne est est levée (Choisir débogage lorsque la fenêtre de message d'erreur s'ouvre).
A+
Bonjour,
Je vais répéter ce que te disais JC:
sinon on va tourner en rond.
Quand tu donnes une erreur, essaie de nous dire sur quelle ligne est est levée (Choisir débogage lorsque la fenêtre de message d'erreur s'ouvre).
A+
Re : Macro pour délimiter
si je dois déposer un bout de code, est ce que ca se fera de manière automatique et ke le fichier s'étalera sur plusieurs feuilles ?
si je dois déposer un bout de code, est ce que ca se fera de manière automatique et ke le fichier s'étalera sur plusieurs feuilles ?
JCGL
XLDnaute Barbatruc
Re : Macro pour délimiter
Bonjour à tous,
......
A part ça l'ami Hasco, ça va chez toi...
Ici il fait beau et chaud.
Allez A++
......
A+ à tous
Bonjour à tous,
......
A part ça l'ami Hasco, ça va chez toi...
Ici il fait beau et chaud.
Allez A++
......
A+ à tous
Staple1600
XLDnaute Barbatruc
Re : Macro pour délimiter
Re
Finalement je repars sur vbscript
PS:Bonjour Hasco 
C'est moi que tu assimiles à Skoobi?
Si c'est le cas, merci de l'honneur
Re
Finalement je repars sur vbscript
Code:
Sub ab()
Dim oFSO
Dim oFS
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFS = oFSO.OpenTextFile("c:\temp\test.txt")
Do Until oFS.AtEndOfStream
i = i + 1
Cells(i, 1) = oFS.ReadLine
Loop
End SubC'est moi que tu assimiles à Skoobi?
Si c'est le cas, merci de l'honneur
Dernière édition:
G
Guest
Guest
Re : Macro pour délimiter
Re
Hamza, si nous te demandons un bout de ton fichier texte c'est pour en connaître la structure exacte et voir ce que l'on peut faire pour toi.
Chaque cas est un cas particulier avec des besoins particulier.
A+
[Edit] Hey L'agrafe, je m'ai encore trompé
JC soleil radieux, sous le châtaigner, je me rafraichis d'une légère brise marine. (fin bulletin méto chalandaise)
Re
Hamza, si nous te demandons un bout de ton fichier texte c'est pour en connaître la structure exacte et voir ce que l'on peut faire pour toi.
Chaque cas est un cas particulier avec des besoins particulier.
A+
[Edit] Hey L'agrafe
, je m'ai encore trompé JC
soleil radieux, sous le châtaigner, je me rafraichis d'une légère brise marine. (fin bulletin méto chalandaise)
Dernière modification par un modérateur:
Re : Macro pour délimiter
il n ya pas de débogage
il nya ke ok et aide
il n ya pas de débogage
il nya ke ok et aide
Re : Macro pour délimiter
pour le fichier tu veux ke je te lenvoi par mail ou autre moyen pcq je narrive pa a le mettre comme piece jointe il me di qu'il est non valide !
pour ce code :
Sub LargeFileImport()
' Dimension Variables.
Dim ResultStr As String
Dim FileName As Variant
Dim FileNum As Integer
Dim Counter As Double
' Ask User for file's name.
FileName = Application.GetOpenFilename("TEXT")
' Check for no entry.
If FileName = False Then End
' Get next available file handle number.
FileNum = FreeFile()
' Open text file for input.
Open FileName For Input As #FileNum
' Turn screen updating off.
Application.ScreenUpdating = False
' Create a new workbook with one worksheet in it.
Workbooks.Add template:=xlWorksheet
Counter = 1
' Loop until the end of file is reached.
Do While Seek(FileNum) <= LOF(FileNum)
' Display importing row number on status bar.
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & FileName
' Store one line of text from file to variable.
Line Input #FileNum, ResultStr
' Store variable data into active cell.
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If
If ActiveCell.Row = 65536 Then
' If on the last row then add a new sheet.
ActiveWorkbook.Sheets.Add
Else
' If not the last row then go one cell down.
ActiveCell.Offset(1, 0).Select
End If
' Increment the counter by 1.
Counter = Counter + 1
' Start again at top of 'do while' statement.
Loop
' Close the open text file.
Close
' Remove message from status bar.
Application.StatusBar = False
End Sub
L'erreur est au niveau de FileName = Application.GetOpenFilename("TEXT")
pour le fichier tu veux ke je te lenvoi par mail ou autre moyen pcq je narrive pa a le mettre comme piece jointe il me di qu'il est non valide !
pour ce code :
Sub LargeFileImport()
' Dimension Variables.
Dim ResultStr As String
Dim FileName As Variant
Dim FileNum As Integer
Dim Counter As Double
' Ask User for file's name.
FileName = Application.GetOpenFilename("TEXT")
' Check for no entry.
If FileName = False Then End
' Get next available file handle number.
FileNum = FreeFile()
' Open text file for input.
Open FileName For Input As #FileNum
' Turn screen updating off.
Application.ScreenUpdating = False
' Create a new workbook with one worksheet in it.
Workbooks.Add template:=xlWorksheet
Counter = 1
' Loop until the end of file is reached.
Do While Seek(FileNum) <= LOF(FileNum)
' Display importing row number on status bar.
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & FileName
' Store one line of text from file to variable.
Line Input #FileNum, ResultStr
' Store variable data into active cell.
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If
If ActiveCell.Row = 65536 Then
' If on the last row then add a new sheet.
ActiveWorkbook.Sheets.Add
Else
' If not the last row then go one cell down.
ActiveCell.Offset(1, 0).Select
End If
' Increment the counter by 1.
Counter = Counter + 1
' Start again at top of 'do while' statement.
Loop
' Close the open text file.
Close
' Remove message from status bar.
Application.StatusBar = False
End Sub
L'erreur est au niveau de FileName = Application.GetOpenFilename("TEXT")
Re : Macro pour délimiter
merci pour le script staple1600 mais il ne prend pa ts les colonnes de mon fichier !!
merci pour le script staple1600 mais il ne prend pa ts les colonnes de mon fichier !!
JCGL
XLDnaute Barbatruc
Re : Macro pour délimiter
Bonjour à tous,
Peux-tu essayer avec :
à la place de
Pour joindre le fichier, il faut le zipper (compresser...)
A+ à tous
Bonjour à tous,
Peux-tu essayer avec :
Code:
= Application.GetOpenFilename("Fichier Texte,*.txt")à la place de
Code:
= Application.GetOpenFilename("TEXT")Pour joindre le fichier, il faut le zipper (compresser...)
A+ à tous
Re : Macro pour délimiter
oui je l'ai changé il me demande de choisir le fichier mais kan jle choisi rien ne passe
oui je l'ai changé il me demande de choisir le fichier mais kan jle choisi rien ne passe
G
Guest
Guest
Re : Macro pour délimiter
Hello le fil,
Petit aparté:
Hey L'agrafe, je m'ai encore trompé
JC soleil radieux, sous le châtaigner, je me rafraichis d'une légère brise marine. (fin bulletin méto chalandaise)
Hamza, c'est pour éviter ce genre de problème( en autres) qu'on te demande un bout de fichier.
A+
Hello le fil,
Petit aparté:
Hey L'agrafe
, je m'ai encore trompé JC
soleil radieux, sous le châtaigner, je me rafraichis d'une légère brise marine. (fin bulletin méto chalandaise)Hamza, c'est pour éviter ce genre de problème( en autres) qu'on te demande un bout de fichier.
A+
Staple1600
XLDnaute Barbatruc
Re : Macro pour délimiter
Re
hamza00:
C'était juste une macro exemple.
Sinon, la macro indiquée par Hascoobi doit fonctionner
PS: tu trouveras aussi des exemples de fils de discussions relatif à l'import de fichiers de plus de 65000 lignes.
Il faut juste le temps de retrouver les fils en question avec le moteur de recherche du forum
Re
hamza00:
C'était juste une macro exemple.
Sinon, la macro indiquée par Hascoobi
doit fonctionnerPS: tu trouveras aussi des exemples de fils de discussions relatif à l'import de fichiers de plus de 65000 lignes.
Il faut juste le temps de retrouver les fils en question avec le moteur de recherche du forum
Re : Macro pour délimiter
j'essaye de compresser le fichier (.rar) mais jarrive pas a le mettre comme piece jointe !!
==> fichier non valide
j'essaye de compresser le fichier (.rar) mais jarrive pas a le mettre comme piece jointe !!
==> fichier non valide
Re : Macro pour délimiter
pour ce code ca a laide très interessant si il decoupe mon fichier sur plusieurs feuilles comme ca je choisité les feuilles dont joré besoin mais apparement il ne marche pas !
il me laisse choisir le fichier .log ke je veux
il louvres sur un nouveau classeur mais juste une seule feuille et elle n'est même pas complète il manque bcp de données !!
Sub LargeFileImport()
' Dimension Variables.
Dim ResultStr As String
Dim FileName As Variant
Dim FileNum As Integer
Dim Counter As Double
' Ask User for file's name.
FileName = Application.GetOpenFilename("Fichier Texte,*.log")
' Check for no entry.
If FileName = False Then End
' Get next available file handle number.
FileNum = FreeFile()
' Open text file for input.
Open FileName For Input As #FileNum
' Turn screen updating off.
Application.ScreenUpdating = False
' Create a new workbook with one worksheet in it.
Workbooks.Add template:=xlWorksheet
Counter = 1
' Loop until the end of file is reached.
Do While Seek(FileNum) <= LOF(FileNum)
' Display importing row number on status bar.
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & FileName
' Store one line of text from file to variable.
Line Input #FileNum, ResultStr
' Store variable data into active cell.
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If
If ActiveCell.Row = 65536 Then
' If on the last row then add a new sheet.
ActiveWorkbook.Sheets.Add
Else
' If not the last row then go one cell down.
ActiveCell.Offset(1, 0).Select
End If
' Increment the counter by 1.
Counter = Counter + 1
' Start again at top of 'do while' statement.
Loop
' Close the open text file.
Close
' Remove message from status bar.
Application.StatusBar = False
End Sub
pour ce code ca a laide très interessant si il decoupe mon fichier sur plusieurs feuilles comme ca je choisité les feuilles dont joré besoin mais apparement il ne marche pas !
il me laisse choisir le fichier .log ke je veux
il louvres sur un nouveau classeur mais juste une seule feuille et elle n'est même pas complète il manque bcp de données !!
Sub LargeFileImport()
' Dimension Variables.
Dim ResultStr As String
Dim FileName As Variant
Dim FileNum As Integer
Dim Counter As Double
' Ask User for file's name.
FileName = Application.GetOpenFilename("Fichier Texte,*.log")
' Check for no entry.
If FileName = False Then End
' Get next available file handle number.
FileNum = FreeFile()
' Open text file for input.
Open FileName For Input As #FileNum
' Turn screen updating off.
Application.ScreenUpdating = False
' Create a new workbook with one worksheet in it.
Workbooks.Add template:=xlWorksheet
Counter = 1
' Loop until the end of file is reached.
Do While Seek(FileNum) <= LOF(FileNum)
' Display importing row number on status bar.
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & FileName
' Store one line of text from file to variable.
Line Input #FileNum, ResultStr
' Store variable data into active cell.
If Left(ResultStr, 1) = "=" Then
ActiveCell.Value = "'" & ResultStr
Else
ActiveCell.Value = ResultStr
End If
If ActiveCell.Row = 65536 Then
' If on the last row then add a new sheet.
ActiveWorkbook.Sheets.Add
Else
' If not the last row then go one cell down.
ActiveCell.Offset(1, 0).Select
End If
' Increment the counter by 1.
Counter = Counter + 1
' Start again at top of 'do while' statement.
Loop
' Close the open text file.
Close
' Remove message from status bar.
Application.StatusBar = False
End Sub
Discussions similaires
- Résolu(e)
