Comment optimiser mon code,

Fermé

muiigisha Messages postés 61 Date d'inscription lundi 25 septembre 2017 Statut Membre Dernière intervention 6 décembre 2017 - 10 nov. 2017 à 10:51
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 - 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

A voir également:

Comment optimiser mon code,
Optimiser pc - Guide
Optimiser windows 10 - Guide
Code asci - Guide
Code puk bloqué - Guide
Code telephone oublié - Guide

3 réponses

Réponse 1 / 3

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
10 nov. 2017 à 11:17

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 Messages postés 61 Date d'inscription lundi 25 septembre 2017 Statut Membre Dernière intervention 6 décembre 2017
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 Messages postés 61 Date d'inscription lundi 25 septembre 2017 Statut Membre Dernière intervention 6 décembre 2017
10 nov. 2017 à 16:17

Sachant que sur 81 colonnes je dois en garder 54

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701 > muiigisha Messages postés 61 Date d'inscription lundi 25 septembre 2017 Statut Membre Dernière intervention 6 décembre 2017
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 Messages postés 61 Date d'inscription lundi 25 septembre 2017 Statut Membre Dernière intervention 6 décembre 2017 > f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024
Modifié le 13 nov. 2017 à 11:34

Bonjour f894009,
malheureusement mes fichiers sont confidentiels, même ceux en csv :(
c'est quoi la messagerie privée?

Bonjour,
https://www.commentcamarche.net/infos/25867-messagerie-privee-mp/

Réponse 2 / 3

muiigisha Messages postés 61 Date d'inscription lundi 25 septembre 2017 Statut Membre Dernière intervention 6 décembre 2017
6 déc. 2017 à 10:52

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

Réponse 3 / 3

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
6 déc. 2017 à 12:03

Bonjour,

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

Discussions similaires

Code de renvoi d'appel : Ooredo, Mobilis...

Acces à snapchat temporairement désactivé

Discussions similaires

Newsletters