Optimiser code vba

Résolu/Fermé

tobas Messages postés 210 Date d'inscription jeudi 23 novembre 2000 Statut Membre Dernière intervention 8 septembre 2014 - Modifié par tobas le 24/07/2013 à 16:07
tobas Messages postés 210 Date d'inscription jeudi 23 novembre 2000 Statut Membre Dernière intervention 8 septembre 2014 - 18 sept. 2013 à 13:32

Bonjour,
j ai crée avec votre aide une macro pour ajouter des infos d'un fichier csv vers un fichier excel avec gestion des doublons
mais je me demande si il y a possibilité optimiser le code pour accélérer le temps d'execution
merci

voici le code

Option Compare Text

Public Nom As String
Public DerLigFichActif As Integer

Sub ImportDesDonnees()

    Application.ScreenUpdating = False                                      'empeche le scitillement de l ecran
    FichActif = ActiveWorkbook.Name                                         'recuperer le nom du fichier actif
    
    '*** repérage dernière ligne ***********************************
    If Range("A2").Value = "" Then                                          'cherche la cellule vide
        DerLigFichActif = 1
    Else: DerLigFichActif = Application.Range("A1").End(xlDown).Row         'on descend dans la colonne
    End If
    
    '***Relevé des entêtes de colonnes ******************************
    ReDim ColCSV(44) As String
    ReDim ColGlobal(44) As String
    
    Sheets("Emplacement").Select                                            'on recupere les entetes des deux fichiers pour
    For i = 1 To 44                                                         'faire des comparaisons
        ColCSV(i) = Cells(i + 2, 2)
        ColGlobal(i) = Cells(i + 2, 4)
    Next i
    
    '*** Recup des données en CSV **********************************
    OuvreFichiers                                                              'on lance le sous programme OuvreFichiers
    Windows(Nom).Activate                                                      'on selectionne la fenetre du fichier csv
    DerLigCSV = Range("A1").End(xlDown).Row                                    'derniere ligne du fichier csv
    For i = 1 To 44                                                            'on remplit la feuille excel
        Range(Cells(2, Int(ColCSV(i))), Cells(DerLigCSV, Int(ColCSV(i)))).Copy 'on copie la colonne - le titre
        Windows(FichActif).Activate                                            'on retourne sur notre fichier
        Sheets("temp").Select                                                  'on selectionne la feuil1
        Cells(2, Int(ColGlobal(i))).Select                                     'on selectionne la premiere cellule vide
        ActiveSheet.Paste                                                      'on colle les données
        Application.CutCopyMode = False                                        'mise en forme des données
        With Selection                                                             'format de la cellule active
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlCenter                                          'police centré vetical
            .WrapText = True
            .Orientation = 0
        End With
        With Selection.Font                                                        'choix de la police
            .Name = "Calibri"
            .Size = 9
        End With
    
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone                        'mise en place des bordures
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        Windows(Nom).Activate                                                  'on retourne dans le fichier csv
    Next i
    Windows(Nom).Close False
    
    MajModifAjout1                                                              'lance le programme de comparaison des feuilles
    
    Worksheets("temp").Range("A2:BZ60000").ClearContents                       'efface les données de transfert
    Windows(FichActif).Activate                                                'on retourne sur notre fichier de depart
    Sheets("Feuil1").Select
        
    Columns("B:B").Select                                                     'mise en place de l'orientation à 90°
    With Selection                                                             'des colonnes
        .Orientation = 90
    End With
     
    Columns("E:E").Select
    With Selection
        .Orientation = 90
    End With
    
    Columns("F:F").Select
    With Selection
        .Orientation = 90
    End With
    
    Columns("G:G").Select
    With Selection
        .Orientation = 90
    End With
    
    Columns("I:I").Select
    With Selection
        .Orientation = 90
    End With
End Sub

Private Sub OuvreFichiers()                                                     'sous programme
    Dim NomFichier As Variant, Filtre As String, cmpt As Long, fich() As String 'definition des variables
    Filtre = "Tous les fichiers(*.CSV),*.CSV"                                   'on veut ouvrir des fichiers csv
    NomFichier = Application.GetOpenFilename(Filtre, 1, "Ouvrir", , True)       'on recupere le nom du fichier
    If IsArray(NomFichier) Then                                                 'on met en forme le fichier
        For cmpt = LBound(NomFichier) To UBound(NomFichier)
            Application.Workbooks.Open NomFichier(cmpt), Local:=True            'ouverture du fichier
            Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
               TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
               Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
               :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 4), Array(5, 1), Array(6, 1), _
               Array(7, 1), Array(8, 1), Array(9, 4), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
               ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
               (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
               Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
               33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
               Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 4), Array(44, 1)), _
               TrailingMinusNumbers:=True
        Next cmpt
    End If
   Nom = ActiveWorkbook.Name
End Sub



Private Sub MajModifAjout1()
    'Relevé des références************************************
    Sheets("Temp").Select 'Feuille source
    ReDim Ref(Range("A65536").End(xlUp).Row) As String
    For i = 2 To Range("A65536").End(xlUp).Row
        Ref(i) = Cells(i, 2).Value
        Range(Cells(i, 1), Cells(i, 44)).Copy
        'Contrôle, copie ou remplacement **************************
        Sheets("Feuil1").Select
        Set C = Columns("B").Find(Ref(i), LookIn:=xlValues)
        If C Is Nothing Then GoTo Ajouter
        C.Select
        Cells(C.Row, 1).Select
        ActiveSheet.Paste 'si la référence existe on remplace la ligne existante par les nouvelles données
        GoTo Suivant
        
Ajouter:
        Cells(DerLigFichActif + 1, 1).Select
        ActiveSheet.Paste 'c'est une nouvelle référence on lajoute à la suite
        DerLigFichActif = ActiveCell.Row
        
Suivant:
        Sheets("Temp").Select
    Next
End Sub

A voir également:

Optimiser code vba
Optimiser pc - Guide
Optimiser windows 10 - Guide
Code asci - Guide
Code puk bloqué - Guide
Code telephone oublié - Guide

2 réponses

Réponse 1 / 2

tobas Messages postés 210 Date d'inscription jeudi 23 novembre 2000 Statut Membre Dernière intervention 8 septembre 2014 24
7 août 2013 à 10:25

bonjour et merci d'avoir répondu,
pour le point 1
toutes les lignes sont remplies donc pas de vide
pour le point 2
je passe par une feuille ou je compare mes entêtes de mes deux fichiers (excel et csv) car les titres des colonnes sont différentes dans les fichiers

pour le csv c'est un fichier texte separe par ";" et des commentaires sont entre guillemet

j'ai déjà un peu optimiser le code en mettant la mise en page à la fin du code et en regroupant les mise en forme

encore merci d'avoir pris du temps pour moi

philmtjn Messages postés 59 Date d'inscription mardi 3 août 2004 Statut Membre Dernière intervention 26 juillet 2017 4
7 août 2013 à 14:25

pas de problème ;)

il est des fois difficile de voir le but final... et optimiser est des fois dangereux sans savoir ce qui sert ou pas.
C'est pour cela que je t'ai donné ces pistes.
si les colonnes sont dans le même ordre, on peut aussi voir le fichier CSV comme un "bête" fichier texte et le traiter ligne a ligne et on met a la suite du fichier destination en comptant les ;
premier champs (0) =colonne initiale.... 1 ; de trouvé ..... champs 1.... 20 ; de trouvé =colonne U (qui est la 20e+1 lettre de l'alphabet.....)
Ca évite d'avoir toute la partie de conversion...

Celà peut paraître compliqué vu comme ça.

Il faudrait avoir les fichiers pour tester en "vrai"

bonne optimisation

tobas Messages postés 210 Date d'inscription jeudi 23 novembre 2000 Statut Membre Dernière intervention 8 septembre 2014 24
7 août 2013 à 14:40

merci

philmtjn Messages postés 59 Date d'inscription mardi 3 août 2004 Statut Membre Dernière intervention 26 juillet 2017 4
18 sept. 2013 à 09:55

bonjour Tobas,
avez-vous lu ce qui est en dessous ?
cela a-t-il servi ?
bonne journée

tobas Messages postés 210 Date d'inscription jeudi 23 novembre 2000 Statut Membre Dernière intervention 8 septembre 2014 24
18 sept. 2013 à 13:32

bonjour philmtjn,
oui je l ai lu et j ai modifie certaines ligne de code par rapport à tes remarques
encore merci de ton aide

Réponse 2 / 2

philmtjn Messages postés 59 Date d'inscription mardi 3 août 2004 Statut Membre Dernière intervention 26 juillet 2017 4
Modifié par philmtjn le 6/08/2013 à 20:34

Bonjour,

1/
déjà, le fait de repérer la dernière ligne non-vide ('*** repérage dernière ligne ), il faut être sûr qu'il n'y a pas de cellule vide en colonne A sur une ligne qui n'est pas la dernière... Il vaut mieux se placer en bas du tableau et chercher en remontant en prenant une colonne où l'on sait qu'il y a des valeurs sur toutes les lignes.
En admettant que la colonne A n'est jamais vide quelque soit la ligne, cela donne :

DerLigFichActif=[A65535].End(xlUp).row
à la place de tout le bloc qui s'intitule : '*** repérage dernière ligne dans l'Import des données.

2/
dans le "relevé des entêtes" ... il me semble que la récupération est à l'envers... il y a un entête par ligne ???
ne serait-ce pas plutot :

'***Relevé des entêtes de colonnes ******************************
ReDim ColCSV(44) As String
ReDim ColGlobal(44) As String

Sheets("Emplacement").Select 'on recupere les entetes des deux fichiers pour
For i = 1 To 44 'faire des comparaisons
ColCSV(i) = Cells(2,i+ 2)
ColGlobal(i) = Cells( 4,i+ 2)
Next i

Ca voudrait dire qu'il y a 44 cellules impactées de gauche a droite de la cellule B2 à AS2 qui seraient rangés dans le tableau ColCSV
et de B4 à AS4 pour le tableau ColGlobal

ou si je pense que les colonnes sont cote à cote (de B2 à AS2 et de AT2 à CK2 soit AT+44+1) :
For i = 1 To 44 'faire des comparaisons
ColCSV(i) = Cells(2,i+ 2)
ColGlobal(i) = Cells( 2,i+ (44+1)+2) 'j'ai mis le détail du calcul, mais on peut mettre i+47
Next i

...Si c'est dans deux fichiers différents, il faut préciser le nom de chaque fichier et de l'onglet...

Pour gagner du temps, il vaut mieux récupérer des valeurs que de faire des copier/coller ... donc évitons .copy et .paste et recopions plutôt les valeurs qui se trouvent a l'intérieur des tableaux.

For i=ligneDebut to ligneFin
For j=colonneDebut to colonneFin
workbooks(nom du fichier recevant les données).sheets(nom de l'onglet).cells(i,j)= _
workbboks(nom du fichier source).sheets(onglet source).cells(i+decalageLigne entre les deux onglets,j+decalagecolonne entre les deux onglets)
next
next

cela ira BEAAAAUUUUCOUP plus vite. Il sera toujours possible de sélectionner les cellules non-vides d'une zone avec une instruction Excel et de tracer les lignes par un
selection.borders.LineStyle = xlContinuous
selection.borders..Weight = xlThin
pour toucher les 4 cotés de chaque cellule sélectionnée en même temps

... Je ne comprend pas trop la façon que vous utilisez pour récupérer le CSV (en l'ouvrant en définissant chacune des 44 colonnes (heureusement qu'iln'y en a pas 256...)

Il faudrait peut etre que je vois 5 lignes des CSV que vous avez a mettre dans le Excel.... mais comme ça, je pense qu'on peut aussi faire quelque chose...
le fichier CSV... est un fichier texte ? A-t-il des séparateurs entre les champs (genre une tabulation [chr(9)] ou un ; ??? les champs sont-ils entre " ou pas ???
On pourrait peut-etre le traiter comme un fichier séquentiel...
A voir ....

J'espère que mes remarques vous aideront

Discussions similaires

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

Acces à snapchat temporairement désactivé

code d'activation GTA 5 steam

Discussions similaires

Newsletters