IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Optimiser une macro


Sujet :

Macros et VBA Excel

  1. #1
    Nouveau membre du Club
    Inscrit en
    Février 2008
    Messages
    34
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 34
    Points : 25
    Points
    25
    Par défaut Optimiser une macro
    Bonjour à tous,

    j'ai écris cette macro, qui fonctionne seulement elle est pas optimale vu qu'elle consomme un temps fou pour obtenir le résultat.

    en fait j'ai deux feuilles "feuil1" et "feuil2" ---> ce que je cherche à faire c'est de chercher l'équivalent de chaque cellule de la colonne C de la feuille 1 dans la colonne B de la feuille 2 ---> une fois trouvé il doit m'afficher le contenu de la cellule de la colonne C de la feuille 2 dans la colonne CV de la feuille 1.


    en fait une recherchev fait l'affaire seulement je veux pas faire du Recherchev.

    ex:

    feuille1......................feuille 2
    colonne B...................colonne B...............colonne C
    A...............................A.........................Toto
    B...............................G.........................Tata
    C...............................C .........................Titi
    D...............................D..........................Bla
    .................................B..........................Mami


    mon résultat est:

    feuille1
    colonne B........................................colonne CV
    A...................................................Toto
    B....................................................Mami
    C....................................................Titi
    D....................................................Bla



    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    Sub Externe()
     
    For j = 0 To Cells(65536, 3).End(xlUp).Row - Cells(1, 3).Row
     
    k = 0
     
    Do While Not (Worksheets("Feuil2").Cells(k + 2, 2) = Worksheets("Feuil1").Cells(j + 2, 3) _
    Or IsEmpty(Worksheets("Feuil2").Cells(k + 2, 2)))
                k = k + 1
    Loop
     
     Worksheets("Feuil1").Cells(j + 2, 100) = Worksheets("Feuil2").Cells(k + 2, 3)
     
     Next
     
    End Sub
    je crois que le fait de boucler avec une boucle do...loop n'est pas optimal.
    peut être qu'il faut passer par des variables tableau???

    Merci

  2. #2
    Membre du Club
    Profil pro
    Inscrit en
    Avril 2008
    Messages
    52
    Détails du profil
    Informations personnelles :
    Âge : 51
    Localisation : France

    Informations forums :
    Inscription : Avril 2008
    Messages : 52
    Points : 68
    Points
    68
    Par défaut
    heu juste pour info ta macro dois gérer combien de lignes?

    si effectivement tu dois la faire tourner sur 65536 lignes par feuille c'est normal que ça prenne du temps

  3. #3
    Nouveau membre du Club
    Inscrit en
    Février 2008
    Messages
    34
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 34
    Points : 25
    Points
    25
    Par défaut
    elle tourne pas sur 65536 lignes.

  4. #4
    Membre confirmé
    Inscrit en
    Janvier 2008
    Messages
    467
    Détails du profil
    Informations forums :
    Inscription : Janvier 2008
    Messages : 467
    Points : 493
    Points
    493
    Par défaut
    Bonsoir
    voici un code avec 1500 lignes il fait 0,4 s
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    Sub test()
    Dim rngBF1 As Range, rngBF2, cell As Range
    Dim temp, i As Integer
    i = 1
     
    Set rngBF1 = Sheets("Feuil1").Range("B2:" & Sheets( _
                 "Feuil1").Cells(Rows.Count, 2).End(xlUp).Address)
    Set rngBF2 = Sheets("Feuil2").Range("B2:" & Sheets( _
                 "Feuil2").Cells(Rows.Count, 2).End(xlUp).Address)
     
    ReDim temp(1 To rngBF1.Count)
     
    For Each cell In rngBF2
    If Not IsError(Application.Match(cell, rngBF1, 0)) Then
       temp(i) = cell.Offset(, 1).Value
       i = i + 1
       End If
    Next
     
    Sheets("Feuil1").Range("CV2").Resize(i, 1).Value = Application.Transpose(temp)
     
    End Sub
    Bonne soirée.

    EDIT
    tu peux remplacer cette ligne de code pour ignorer les champs vides de la colonne C
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    temp(i) = cell.Offset(, 1).Value
    par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If Not IsEmpty(cell.Offset(, 1).Value) Then temp(i) = cell.Offset(, 1).Value:i = i + 1

  5. #5
    Nouveau membre du Club
    Inscrit en
    Février 2008
    Messages
    34
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 34
    Points : 25
    Points
    25
    Par défaut
    Bonjour Abed_H
    Ton code ne prend pas en compte le cas où j'ai des doublons dans ma colonne B de la feuille 1

    du moment où j'ai des doublons dans ma colonne B ---> le code ne fonctionne plus.

    je ne sais pas pourquoi ???

    Quelqu'un pourra - t - il m'aider à convertir mon code exposé ci-dessus, en code plus optimal ------> passer par des variables tableau

  6. #6
    Membre émérite
    Profil pro
    Inscrit en
    Juillet 2007
    Messages
    2 130
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2007
    Messages : 2 130
    Points : 2 443
    Points
    2 443
    Par défaut
    Salut à tous
    Attention :
    - La macro est dans un module général (pas un module de classe feuille) ou dans le module ThisWorkBook
    - Le nom des feuilles est à vérifier/adapter
    Pour toutes les cellules (Cel) de Feuil1 colonne B
    vider cel_1
    rechercher la cellule égale en feuil2 colonne B et stocker la cellule en variable Cel_1
    Si Cel_1 n'est pas vide mettre la valeur de la colonne de droite de cel_1 dans la colonne de droite de la cellule testée :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    Sub Externe()
    Dim Cel As Range
    Dim F_1 As Worksheet
    Dim F_2 As Worksheet
    Dim Cel_1 As Range
    Set F_1 = Sheets("Feuil1")
    Set F_2 = Sheets("Feuil2")
    For Each Cel In Range(F_1.[B1], F_1.[B65536].End(xlUp))
        Set Cel_1 = Nothing
        Set Cel_1 = F_2.Range(F_2.[B1], F_2.[B65536].End(xlUp)).Find(Cel, LookIn:=xlValues)
        If Not (Cel_1 Is Nothing) Then Cel.Offset(0, 1) = Cel_1.Offset(0, 1)
    Next Cel
    End Sub
    A+

  7. #7
    Nouveau membre du Club
    Inscrit en
    Février 2008
    Messages
    34
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 34
    Points : 25
    Points
    25
    Par défaut
    Gorfael ---> toujours à ma rescousse.

    ça marche nikel

    Merci à toi aussi Abed_H

  8. #8
    Nouveau membre du Club
    Inscrit en
    Février 2008
    Messages
    34
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 34
    Points : 25
    Points
    25
    Par défaut
    Je me permets de relancer la discussion.

    En fait si Cel_1 est nothing, je voudrais stocker dans un tableau toutes les Cel que je ne trouve pas dans la feuille2
    et à la fin de la macro je les affiche dans une feuille 3.
    Merci

  9. #9
    Membre émérite
    Profil pro
    Inscrit en
    Juillet 2007
    Messages
    2 130
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2007
    Messages : 2 130
    Points : 2 443
    Points
    2 443
    Par défaut
    Salut PiliSql
    Me semblerai plus simple de les copier au fur et à mesure
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    Sub Externe()
    Dim Cel As Range
    Dim F_1 As Worksheet
    Dim F_2 As Worksheet
    Dim Cel_1 As Range
    Set F_1 = Sheets("Feuil1")
    Set F_2 = Sheets("Feuil2")
    For Each Cel In Range(F_1.[B1], F_1.[B65536].End(xlUp))
        Set Cel_1 = Nothing
        Set Cel_1 = F_2.Range(F_2.[B1], F_2.[B65536].End(xlUp)).Find(Cel, LookIn:=xlValues)
        If Cel_1 Is Nothing Then
            Cel.Copy F_2.Range("B" & F_2.[B65536].End(xlUp).Row + 1)
        Else
            Cel.Offset(0, 1) = Cel_1.Offset(0, 1)
        End If
    Next Cel
    End Sub
    un truc dans ce style, qui permet d'éviter d'avoir à traiter les doublons
    A+

  10. #10
    Nouveau membre du Club
    Inscrit en
    Février 2008
    Messages
    34
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 34
    Points : 25
    Points
    25
    Par défaut
    Non Gorfael,

    Moi j'aimerais les stocker dans un tableau pour ensuite imprimer une sorte de rapport d'erreur soit à l'aide de word soit bloc notes.

Discussions similaires

  1. [XL-2010] Optimiser une macro
    Par laguernette dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 01/11/2013, 23h56
  2. [XL-2003] Optimiser une macro
    Par mikadoo57 dans le forum Macros et VBA Excel
    Réponses: 21
    Dernier message: 26/03/2013, 15h59
  3. Optimiser une macro
    Par foxrol dans le forum Macro
    Réponses: 5
    Dernier message: 01/03/2012, 18h24
  4. [XL-2003] Optimiser une macro VBA
    Par momo93240 dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 19/07/2011, 17h46
  5. [XL-2003] Optimiser une macro de mise en forme d'un Tableau
    Par mouncefdi dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 10/04/2009, 13h19

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo