optimiser code vba Résolu/Fermé

Question

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



 


Configuration: Windows Vista / Firefox 22.0

philmtjn · Answer

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

tobas · Answer

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

Optimiser code vba

2 réponses

Discussions similaires