Comment optimiser mon code,

muiigisha Messages postés 61 Statut Membre -  
f894009 Messages postés 17417 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

3 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    1. muiigisha Messages postés 61 Statut Membre
       
      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
    2. muiigisha Messages postés 61 Statut Membre
       
      Sachant que sur 81 colonnes je dois en garder 54
      0
      1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > muiigisha Messages postés 61 Statut Membre
         
        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
      2. muiigisha Messages postés 61 Statut Membre > f894009 Messages postés 17417 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
  2. muiigisha Messages postés 61 Statut Membre
     
    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
  3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

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