Comment optimiser mon code,

muiigisha Messages postés 61 Date d'inscription   Statut Membre Dernière intervention   -  
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   -
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

A voir également:

3 réponses

Réponse 1 / 3
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
0
muiigisha Messages postés 61 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
muiigisha Messages postés 61 Date d'inscription   Statut Membre Dernière intervention  
 
Sachant que sur 81 colonnes je dois en garder 54
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > muiigisha Messages postés 61 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
muiigisha Messages postés 61 Date d'inscription   Statut Membre Dernière intervention   > f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour f894009,
malheureusement mes fichiers sont confidentiels, même ceux en csv :(
c'est quoi la messagerie privée?
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > muiigisha Messages postés 61 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,
https://www.commentcamarche.net/infos/25867-messagerie-privee-mp/
0
Réponse 2 / 3
muiigisha Messages postés 61 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
Réponse 3 / 3
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Vous pouvez mettre un fichier avec des donnees representatives car pas simple de simuler avec vos tests
0