Menu

Comment optimiser mon code,

muiigisha 61 Messages postés lundi 25 septembre 2017Date d'inscription 6 décembre 2017 Dernière intervention - 10 nov. 2017 à 10:51 - Dernière réponse : f894009 13261 Messages postés dimanche 25 novembre 2007Date d'inscription 18 juillet 2018 Dernière intervention
- 6 déc. 2017 à 12:03
Bonjour,

j'ai écrit quelques lignes de code et lors de la compilation j'en ai au moins pour 5 minutes, je trouve ça bizarre parce que si je compile pas à pas ç'est plutôt rapide et k'ai qu'une seule boucle for. J 'ai mis des" application.screeupdating=false" à n'en plus finir mais toujours rien.

Voici mon code, pouvez m'aider à l'optimiser et me donner des conseils pour la prochaine fois?


Dim Wbk As Workbook, iprF As Workbook, iprCC As Workbook
Dim file, Quelfichier As Variant
Dim ctr As Long
Quelfichier = Application.GetOpenFilename _
(Title:="Please Select an input excel file", _
FileFilter:="Excel Files *.csv (*.csv),")
Application.ScreenUpdating = False
Set iprCC = Workbooks.Open(Quelfichier)

Application.ScreenUpdating = False

iprCC.Activate
Range("B1:B80227,E1:E80227,G1:G80227,L1:L80227,N1:N80227,P1:P80227,Q1:Q80227,R1:R80227,S1:S80227,V1:V80227,W1:W80227,Y1:Y80227,Z1:Z80227").Select
Selection.EntireColumn.Delete
Range("N1:N80227,Q1:Q80227,R1:R80227,U1:U80227,X1:X80227,AB1:AB80227,AC1:AC80227,AD1:AD80227,AE1:AE80227,AF1:AF80227,AH1:AH80227,AL1:AL80227,AM1:AM80227,AN1:AN80227,AO1:AO80227,AP1:AP80227,AX1:AX80227,AZ1:AZ80227").Select
Selection.EntireColumn.Delete
Range("AI1:AI80227,AJ1:AJ80227,AK1:AK80227,AN1:AN80227,AO1:AO80227,AP1:AP80227,AR1:AR80227,AS1:AS80227,AT1:AT80227,AU1:AU80227,AW1:AW80227,BD1:BD80227,BF1:BF80227,BG1:BG80227,BH1:BH80227").Select
Selection.EntireColumn.Delete
Range("AU1:AU80227,AV1:AV80227,AW1:AW80227,AX1:AX80227,AY1:AY80227,AZ1:AZ80227,BB1:BB80227,BD1:BD80227,BE1:BE80227,BF1:BF80227,BG1:BG80227,BH1:BH80227,BI1:BI80227,BJ1:BJ80227,BK1:BK80227,BL1:BL80227,BM1:BM80227").Select
Selection.EntireColumn.Delete
Range("AW1:AW80227,AY1:AY80227,AZ1:AZ80227,BA1:BA80227,BB1:BB80227,BC1:BC80227").Select
Selection.EntireColumn.Delete

Call Cleanse_File(iprCC)
iprCC.RefreshAll
iprCC.SaveAs FileFormat:=xlExcel12
iprCC.Close savechanges:=True

MsgBox "File Standardization completed!", vbExclamation, "!! Warning !!"

End Sub

Sub Cleanse_File(Wbk As Workbook)

Dim i As Long
Wbk.Activate

Application.ScreenUpdating = False
With Wbk.Sheets(1)
For i = .Range("H" & .Rows.Count).End(xlUp).Row To 2 Step -1
If .Range("H" & i).value <> "" Then
.Rows(i).Delete
End If
Next i
End With

Application.ScreenUpdating = False

Cells.Replace What:="EST", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Cells.Replace What:="EDT", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Wbk.Save

End Sub


Sachant que normalement à l'ouverture je sélectionne 2 fichiers et que le traitement est appliqué sur ces 2 fichiers

Merci d'avance

Afficher la suite 

Votre réponse

8 réponses

f894009 13261 Messages postés dimanche 25 novembre 2007Date d'inscription 18 juillet 2018 Dernière intervention - 10 nov. 2017 à 11:17
0
Merci
Bonjour,

Vous deletez deux fois les memes colonnes
Range("N1:N80227,Q1:Q80227,R1:R80227,


IL serait peut-etre plus judicieux de copier les colonnes dont vous avez besoin dans un autre fichier et faire vos suppressions de ligne et remplacement de texte dans ce fichier

Suppression ligne: si moins de lignes a supprimer qu'a conserver, code a optimiser faut voir
muiigisha 61 Messages postés lundi 25 septembre 2017Date d'inscription 6 décembre 2017 Dernière intervention - 10 nov. 2017 à 11:38
Merci pour ton intervention
la suppression en fait n'est pas faite 2 fois parce qu'en supprimant les colonnes se maettent automatiquement en ordre et je ne peux pas supprimer tout d'un coup parce que VBA ne supporte pas et m'affiche une erreur.
La copie n'est pas plus longue que la suppression? parce que même pas à pas c'est quelques tierces plus long que la suppresion.
Il ya plus de ligne à supprimer qu'à conserver
muiigisha 61 Messages postés lundi 25 septembre 2017Date d'inscription 6 décembre 2017 Dernière intervention - 10 nov. 2017 à 16:17
Sachant que sur 81 colonnes je dois en garder 54
f894009 13261 Messages postés dimanche 25 novembre 2007Date d'inscription 18 juillet 2018 Dernière intervention > muiigisha 61 Messages postés lundi 25 septembre 2017Date d'inscription 6 décembre 2017 Dernière intervention - 10 nov. 2017 à 17:12
Re,

Si vos fichiers csv ne sont pas confidentiels, pouvez-vous en mettre un a dispo et definir en detail ce que vous voulez en fin de traitement???
Pour le fichier a la limite, passez par la messagerie privee
muiigisha 61 Messages postés lundi 25 septembre 2017Date d'inscription 6 décembre 2017 Dernière intervention > f894009 13261 Messages postés dimanche 25 novembre 2007Date d'inscription 18 juillet 2018 Dernière intervention - 13 nov. 2017 à 11:30
Bonjour f894009,
malheureusement mes fichiers sont confidentiels, même ceux en csv :(
c'est quoi la messagerie privée?
f894009 13261 Messages postés dimanche 25 novembre 2007Date d'inscription 18 juillet 2018 Dernière intervention > muiigisha 61 Messages postés lundi 25 septembre 2017Date d'inscription 6 décembre 2017 Dernière intervention - 13 nov. 2017 à 11:35
Commenter la réponse de f894009
muiigisha 61 Messages postés lundi 25 septembre 2017Date d'inscription 6 décembre 2017 Dernière intervention - 6 déc. 2017 à 10:52
0
Merci
Bonjour,
merci pour l'aide apportée la derniere fois celà m'a beaucoup édifié même si finalement je n'ai pas utilisé exactement ce que vous m'avez envoyé mais ça été un guide en tout cas.
Je reviens avec un autre problème d'optimisation; j'ai ce code suivant:

Option Base 1
Sub test()

Dim main() As Variant, parameter() As Variant
Dim paraDte, mainDte, mostrecentDte As Date
Dim tabIDrows() As Integer
Dim id As Integer

ReDim tabIDrows(15)

Application.ScreenUpdating = False

ThisWorkbook.Worksheets("Sheet1").Activate

Application.ScreenUpdating = False

main = Range("B2:E5000").Value
parameter = Range("B2:E5000").Value
For cmpt1 = LBound(main, 1) To UBound(main, 1)
ReDim tabIDrows(15)
id = 1
For cmpt2 = LBound(parameter, 1) To UBound(parameter, 1)
'If Sheets("Sheet1").Range("B" & cmpt1 + 1 & ":D" & cmpt1 + 1).Value =
'Sheets("Sheet1").Range("B" & cmpt2 + 1 & ":D" & cmpt2 + 1).Value Then 'main("B" & cmpt1 & ":D" & cmpt1).Value = parameter("B" & cmpt2 & ":E" & cmpt2).Value Then
If main(cmpt1, 1) = parameter(cmpt2, 1) And main(cmpt1, 2) = parameter(cmpt2, 2) And main(cmpt1, 3) = parameter(cmpt2, 3) Then
If Range("E" & cmpt2 + 1).Value <> "" Then
paraDte = Range("E" & cmpt2 + 1)
mainDte = Range("E" & cmpt1 + 1)
tabIDrows(id) = cmpt2 + 1
id = id + 1
If paraDte > mainDte Then
mostrecentDte = paraDte
Else
mostrecentDte = mainDte
End If
End If
Else
Range("F" & cmpt1 + 1).Value = Range("E" & cmpt1 + 1).Value
End If
Next cmpt2
id = 1
While tabIDrows(id) <> 0
Range("F" & tabIDrows(id)) = mostrecentDte
id = id + 1
Wend
Next cmpt1
'Range("F" & cmpt2) = mostrecentDte
End Sub



j'ai mis (je crois) ce qu'il fallait pour aller au plus vite mais seulement il met à peu près 5 mins pour ne parcourir que 700 lignes environ et pourtant j'ai devant moi un fichier de 25000 lignes.

Aidez moi svp.

Merci d'avance
Commenter la réponse de muiigisha
f894009 13261 Messages postés dimanche 25 novembre 2007Date d'inscription 18 juillet 2018 Dernière intervention - 6 déc. 2017 à 12:03
0
Merci
Bonjour,

Vous pouvez mettre un fichier avec des donnees representatives car pas simple de simuler avec vos tests
Commenter la réponse de f894009