Appel d'un txt

[gab]

Bonjour,

J'utilise ce petit code qui ouvre un fichier txt dans Excel en effectuant des manips de format, copie/colle les données dans la feuille 'datas' et ferme le txt.
Le problème, c'est que plus le fichier txt est volumineux, plus cela prend du temps...

N'y aurait-il pas moyen d'optimiser un peu tout ça ? Merci

Application.ScreenUpdating = False
Sheets('all').Range('A2:E30').ClearContents
Workbooks.OpenText FileName:='\\\\rep\\main.txt', Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=True, Space:=False, Other:=True, OtherChar:=';', FieldInfo:= _
Array(Array(1, 2), Array(2, 2), Array(3, 4), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
, 1))
Cells.EntireColumn.AutoFit

Workbooks('main.txt').Activate
Cells.Select
Selection.Copy
Windows('MP.xls').Activate
Sheets('datas').Select
Cells.Select
ActiveSheet.Paste
Workbooks('main.txt').Close savechanges:=False

 

[Hellboy]

Bonjour gab

J'essaie cette proposition:

Application.ScreenUpdating = False
Sheets('all').Range('A2:E30').ClearContents
Workbooks.OpenText Filename:='c:\main.txt', Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=True, Space:=False, Other:=True, OtherChar:=';', FieldInfo:= _
Array(Array(1, 2), Array(2, 2), Array(3, 4), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
, 1))

With Workbooks('main.txt')
        .ActiveSheet.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
        .CurrentRegion.Copy Destination:=Windows('MP.xls').Sheets('datas').Cells(1, 1)
        .Close savechanges:=False
End With

Message édité par: Hellboy, à: 24/11/2005 14:42

 

[gab]

une petite coquille...

il faut lire :
Workbooks.OpenText FileName:='\\rep\\main.txt', (etc...)

 

[gab]

ah ben mince....
le \\ n'apparait pas entre rep et main......

 

[Hellboy]

re gab

La petite coquille, il faut que tu m'explique, parce que tu ne fait pas référence a ce fichier ailleur que là. Ça c'est plus une coquille ! Ce qui me tracasse aussi, la commande 'OpenText Filename:=' normalement demande un chemin d'accès au fichier qui doit être ouvert, toi tu en as pas de besoin ???

a+

 

[gab]

gab écrit:

ah ben mince....
le \\ n'apparait pas entre rep et main......

tiens... antislash n'apparait pas ici.....

 

[PascalXLD]

bonjour

Mets 4 \\\\\\\\ pour le voir l'antislash

 

[gab]

\\\\\\\\

 

[gab]

OK....


une petite coquille...

il faut lire :
Workbooks.OpenText FileName:='rep\\\\\\\\main.txt', (etc...)

 

[gab]

salut Hellboy

j'ai un Run-time error '438' sur la ligne
.CurrentRegion.Copy Destination:=Windows('MP.xls').Sheets('datas').Cells(1, 1)

 

[Hellboy]

re

serait-ce mieux ?

With Workbooks('main.txt').ActiveSheet.Cells(1, 1).Cells.SpecialCells(xlCellTypeLastCell).CurrentRegion
                .EntireColumn.AutoFit
                .Copy Destination:=Workbooks('MP.xls').Sheets('datas').Cells(1, 1)
End With

 

[gab]

Oui ca marche maintenant....
Sauf que bon.... ca change pas grand chose à la durée d'execution..
C'est pas grave tant pis... c'est long et pis c'est tout...
Cela dit ,c'est peut être à cause du reste du code....

Sheets('datas').Select

Rows('1:1').Select
Selection.Insert Shift:=xlDown

compter = WorksheetFunction.CountA(Columns(1)) + 1

ActiveWorkbook.Names('ListPays').Delete
With ActiveWorkbook.Names
.Add Name:='colpays', RefersToR1C1:='=datas!R1C1:R' & compter & 'C1'
.Add Name:='Pays', RefersToR1C1:='=datas!R2C1:R' & compter & 'C1'
.Add Name:='Colcat', RefersToR1C1:='=datas!R1C2:R' & compter & 'C2'
.Add Name:='cat', RefersToR1C1:='=datas!R2C2:R' & compter & 'C2'
.Add Name:='coldate', RefersToR1C1:='=datas!R1C3:R' & compter & 'C3'
.Add Name:='date', RefersToR1C1:='=datas!R2C3:R' & compter & 'C3'
.Add Name:='colnombre', RefersToR1C1:='=datas!R1C4:R' & compter & 'C4'
.Add Name:='Nombre', RefersToR1C1:='=datas!R2C4:R' & compter & 'C4'
.Add Name:='Nombre2', RefersToR1C1:='=datas!R2C5:R' & compter & 'C5'

Sheets('main').Select

.Add Name:='ListPays', RefersToR1C1:='=main!R2C4:R' & Range('b2').Value + 2 & 'C4'
End With
Application.DisplayAlerts = True