begin process at 2012 02 15 06:44:09
  Trouver un code source :
 
dans
 
Accueil > Forum > 

Archive Visual Basic & VB.NET

 > 

Archives Visual Basic

 > 

J'AI BESOIN D'AIDE !!!! :)

 > 

Code améliorable ou pas???


Derniers messages déposésPoser une question dans le forum ou lancer une discussion

Code améliorable ou pas???

mardi 3 août 2004 à 15:07:24 | Code améliorable ou pas???

Clonk

Bonjour,
J'ai un problème d'optimisation de code (ouais, C relou, je sais!)
Voilà, je dois lire 2 fichiers texte sous VB 6.0 (et pas VBA) et les copier les lignes sosu excel (avec toutes les contraintes que cela implique)
Le problème, c'est que ça prends un temps monstre dès qu'on dépasse les 5 megs!!!
Si quelqu'un a une version plus rapide, ou s'il voit pourquoi, chez moi ça prends ouat's mille années, il serait sympa de se manifester ^^


RecMAX = 32000
i = 0
numFeuill = 1
nbCarac = 0
currentY = 2
ColWidth = 0
Export = ""
DateFile = Now
DateFile = Replace(DateFile, "/", "-")
DateFile = Replace(DateFile, ":", "-")
DateFile = Replace(DateFile, " ", "-")
NomFichier = App.Path & "\Resultats_" & DateFile & ".xls"
FrmStart.MousePointer = vbHourglass
FileNumber = FreeFile
OpenedFile = App.Path & "\final.txt"
UnknownData = App.Path & "\unknown.txt"
If fso.FileExists(OpenedFile) Then
FrmExc.ProgressBar1.Min = 0
FrmExc.ProgressBar1.Max = FileLen(OpenedFile) + FileLen(UnknownData)
FrmExc.ProgressBar1.Value = 0
Open OpenedFile For Input As #FileNumber
Set Exc = CreateObject("excel.application")
Set Wb = Exc.Workbooks.Add
Set Ws = Wb.Worksheets(1)
With Exc
.Visible = False
End With
nbSheets = Exc.Sheets.Count
While Not EOF(1)
Line Input #1, buff
buff = Replace(buff, vbCrLf, "")
If buff <> "" Then
nbCarac = nbCarac + Len(buff)
tmp = limit
limit = getSeparator(buff)
If limit = "0" Then limit = tmp
MyTest = Split(buff, limit)
i = i + 1
j = 0
currentX = 2
For j = 0 To UBound(MyTest)
Ws.Cells(currentY, currentX).Characters.Caption = MyTest(j)
currentX = currentX + 1
Next j
Ws.Range(Ws.Cells(currentY, 2), Ws.Cells(currentY, (UBound(MyTest) + 2))).Borders.Weight = xlThin
If Len(buff) >= ColWidth Then
ColWidth = Len(buff)
Ws.Columns.AutoFit
End If
If currentY < 32000 Then
currentY = currentY + 1
Else
currentY = 2
numFeuill = numFeuill + 1
If numFeuill > nbSheets Then
Set Ws = Wb.Worksheets.Add
Else
Set Ws = Wb.Worksheets(numFeuill)
End If
End If
End If
FrmExc.LblAvanc.Caption = Round(((nbCarac / FrmExc.ProgressBar1.Max) * 100), 2) & "% effectués"
FrmExc.ProgressBar1.Value = nbCarac
DoEvents
Wend
Close #FileNumber
'----------------------------------------------------------------
'- 2 -
'----------------------------------------------------------------
Previoussize = nbCarac
nbCarac = 0
numFeuill = numFeuill + 1
If numFeuill > nbSheets Then
Set Ws = Wb.Worksheets.Add
Else
Set Ws = Wb.Worksheets(numFeuill)
End If
ColWidth = 0
currentY = 2
Ws.Range(Ws.Cells(currentY, 2), Ws.Cells(currentY, 10)).MergeCells = True
Ws.Range(Ws.Cells(currentY, 2), Ws.Cells(currentY, 10)).Font.Bold = True
Ws.Range(Ws.Cells(currentY, 2), Ws.Cells(currentY, 10)).Font.Size = 12
Ws.Range(Ws.Cells(currentY, 2), Ws.Cells(currentY, 10)).HorizontalAlignment = xlCenter
Ws.Range(Ws.Cells(currentY, 2), Ws.Cells(currentY, 10)).Borders.Weight = xlMedium
Ws.Cells(currentY, 2) = "Données appartenant à des catégories inconnues :"
currentY = currentY + 1
Open UnknownData For Input As #FileNumber
While Not EOF(1)
If i >= RecMAX Then
Close #FileNumber
FileNumber = FreeFile
Open App.Path & "\unknown.txt" For Input As #FileNumber
Seek #FileNumber, nbCarac
i = 0
End If
Line Input #1, buff

buff = Replace(buff, vbCrLf, "")
nbCarac = nbCarac + Len(buff)
tmp = limit
limit = getSeparator(buff)
If limit = "0" Then limit = tmp
If buff <> "" Then
MyTest = Split(buff, limit)
i = i + 1
j = 0
currentX = 2
For j = 0 To UBound(MyTest)
Ws.Cells(currentY, currentX).Characters.Caption = MyTest(j)
'Ws.Cells(currentY, currentX) = MyTest(j)
currentX = currentX + 1
Next j
Ws.Range(Ws.Cells(currentY, 2), Ws.Cells(currentY, (UBound(MyTest) + 2))).Borders.Weight = xlThin
If Len(buff) >= ColWidth Then
ColWidth = Len(buff)
Ws.Columns.AutoFit
End If
If currentY < 32000 Then
currentY = currentY + 1
Else
currentY = 2
numFeuill = numFeuill + 1
If numFeuill > nbSheets Then
Set Ws = Wb.Worksheets.Add
Else
Set Ws = Wb.Worksheets(numFeuill)
End If
End If
End If
FrmExc.LblAvanc.Caption = Round((((nbCarac + Previoussize) / FrmExc.ProgressBar1.Max) * 100), 2) & "% effectués"
FrmExc.ProgressBar1.Value = nbCarac + Previoussize
DoEvents
Wend



bon courage pour le lire ^_^
mardi 3 août 2004 à 15:52:07 | Re : Code améliorable ou pas???

moustachu

Membre Club
Je regarde, je ne te garanti rien... mais 5 Mégas, ça ne m'étonne pas que ça prenne du temps avec Excel...

++
Moustachu
mardi 3 août 2004 à 16:11:47 | Re : Code améliorable ou pas???

Clonk

bah jme doutais que ça prendrait du temps, mais C enervant quand avec C++, il te met 4 à 5 fois moins de temps (facile) avec 2 à 3 fois plus de traitements (facile).
Mais faire un export sous Excel en C++, ça me broute ;)
mardi 3 août 2004 à 20:42:02 | Re : Code améliorable ou pas???

Satirik

les fichier textes on quelles formes ? (pas envie de me taper tout le code pour me faire une idee) et j'imagine que c'est des fichier texte figé (c'est pas toi qui defini comment ils sont enregistrés)

La Machine
mardi 3 août 2004 à 23:15:06 | Re : Code améliorable ou pas???

Clonk

Ouais, C ptete plus simple en expliquant :
C des fichiers texte ou le format est ainsi:
val1|val2|val3|etc...
je les lis ligne par ligne et le séparateur est le pipe...
donc je fais un split de chaque ligne.
EN plus, je dois vérigfier la taille, parce que Excel plante à 32000 et des brouettes d'enregistrements.
Voilà et je dois faire ça 2 fois avec une mise en page vite fait (mettre des bordures quoi)
mercredi 4 août 2004 à 09:35:51 | Re : Code améliorable ou pas???

moustachu

Membre Club
Salut,

Bon ben j'ai pas trouvé grand chose malheureusement... Peux-tu faire la mise en page "d'un coup" plutot qu'à chaque ligne de texte, après ton wend. Je crois que ça prend du temps ce genre de truc...

Sinon, les fonctions récursives sont plus rapides à exécuter que des boucles for.

J'ai conscience que ce ne sont que des conseils généraux... Je continue de regarder encore un peu :o)

Sinon, histoire de pinailler, tu écris : FileNumber = FreeFile puis While Not EOF(1), au lieu de While Not EOF(FileNumber). Il y a deux ou trois lignes de cdoes dans ce genre...


++
Moustachu
mercredi 4 août 2004 à 09:42:06 | Re : Code améliorable ou pas???

moustachu

Membre Club
Sinon, si tu as des calculs dans tes feuilles :
desactive
Application.Calculation = xlCalculationManual
réactive
Application.Calculation = xlCalculationAutomatic

ou encore :
'gèle le rafraichissement de l'affichage
Application.ScreenUpdating = False
'remet le rafraichissement de l'affichage des cellules
Application.ScreenUpdating = True

mais bon, tu as déjà .visible = false alors...
++
Moustachu
mercredi 4 août 2004 à 11:36:40 | Re : Code améliorable ou pas???

Clonk

cimer moustachu, C déjà ça de gagné (bon, G toujorus ou't mille années d'export quand meme...)
Geffectuvement du mettre en visible = false sinon ça mettait encore plus de temps!

Pour l'import d'un seul coup, perso j'ai pas trouvé de moyen de lire tout le fichier et si je fais ça, je crois que je l'affichage sera chelou nan? (enfin, jdis ça, jdis rien)

et sinon, Incubus rocks ;)
mercredi 4 août 2004 à 11:54:50 | Re : Code améliorable ou pas???

moustachu

Membre Club
Réponse acceptée !
L'affichage risque d'être chelou comme tu dis. Mais si tu charges ton fichier comme ça :

Workbooks.OpenText Filename:= _
app.path & "\a.txt", Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:="|"

C'est du VBA bien sûr mais ça doit pouvoir te guider. Je ne sais pas ce que ça fait si ça dépasse les 32 000 lignes

>et sinon, Incubus rocks ;)
;)


++
Moustachu
mercredi 4 août 2004 à 14:07:34 | Re : Code améliorable ou pas???

Clonk

Oui, effectivement, ça passe, mainteannt, il faut que j'arrive à gérer les ajout de worksheet, mais ça va BEACOUP plus vite déjà!!! Merci!


Cette discussion est classée dans : ws, cells, buff, currenty, nbcarac


Répondre à ce message

Sujets en rapport avec ce message

Problème sur algorithme VBA [ par eastpeople ] Bonjour, Je reposte un message car j'ai de nouveau un problème sur un de mes codes.J'ai un textebox où on rentre des activités puis quand on valide el Problème export Excel vers Access [ par rabihm ] Bonjour,Je vous expose brièvement mon problème.Je dois exporter un fichier excel dans un table de ma base Access.Dans ce fichier excel, je dois export Demande d'aide [ par DAMIEN001 ] bonjour, J'ai un classeur sur lequel je veux faire le remplissage de manière automatique des feuilles de ce classeur. Voici le code que j'ai ecris: Su condition sur du texte [ par dianbobo ] bonjour [^^happy13] ci dessous il y a un code mais j'ai une erreur a la [b]lige 10[/b]:"erreur definie par l'application ou par l'objet " [^^confus2] supprimer les anciennes données a chaque activation d'une liste [ par campagne72 ] bonjour à tous et bonne années voici mon problème je vais chercher dans une liste en c2 des noms une fois un nom sélectionner il me donne tous les pré EXCEL 2007 VBA [ par berousset ] bernard Bonjour, Comment faire pour que les signes ou = soit dans une variable pour faire A = < et ensuite If cells (i, j) & a & c au lieu de If cell VBA Excel - Paramétrage automatique du quadrillage d'un tableau [ par talined ] Bonjour, J'ai une question concernant le quadrillage automatique d'un tableau. J'ai écrit un code qui permet de quadriller un tableau avec une boucle methode cells de l'objet _global a échoué dans boucle pour créer des graphiques [ par emma75 ] Bonjour, Je suis actuellement en train de tenter de créer un script permettant de créer, pour plusieurs données, plusieurs graphiques correspondant. Besoin d'aide Visual basic : Pourquoi ça ne fonctionne pas ? [ par titamy ] Bonjour, J'ai créer un petit programme qui teste les valeurs de cellules de la colonne A. Pour cela je compare la valeur à celle de la cellule qui la Code somme doublons [ par argaz01 ] Bonjour et merci d'avance, La macro suivante marchait très bien il y'a quelques jours sur un autre tableau et maintenant elle ne produit aucun résult


Nos sponsors


Sondage...

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 2,324 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales