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 :

Optimisation macro onglet [XL-2010]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Homme Profil pro
    Étudiant
    Inscrit en
    Février 2014
    Messages
    53
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Février 2014
    Messages : 53
    Par défaut Optimisation macro onglet
    Bonjour a tous,

    Je souhaiterais savoir s'il y a un moyen d'optimiser cette macro. Je m'explique : la première feuille "ITEX_04_2014_ADR2" est la source, selon des critères (colonne D qui sont des libelles) je dois les regrouper dans les onglets correspondants que je créé par la même occasion.

    Donc pour chaque libelle différent une feuille de mon classeur est créée.

    C'est ici que je m'interroge et vous devriez comprendre avec ma macro car j'ai une cinquantaine de libelle et ma macro risque d'être un chouia longue si je continue sur ce modèle

    Ci-dessous avec seulement deux libelles (A0DNK3 et A0DNK5) :


    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
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
     
     
    Sub Delete_Column()
     
    Range("Q:Q,S:U,W:AI").Select
    Range("AI1").Activate
    Selection.Delete Shift:=xlToLeft
     
    End Sub
     
    Sub Funds()
     
    Application.ScreenUpdating = False
     
    Range("D1").AutoFilter Field:=4, Criteria1:="A0DNK3", Operator:=xlOr, Criteria2:="A0DNK5"
     
    Sheets.Add , Worksheets(Worksheets.Count)
    ActiveSheet.Name = "A0DNK3"
    Sheets("A0DNK3").Range("A1:R1").Value = Sheets("ITEX_04_2014_ADR2").Range("A1:R1").Value
     
    Sheets.Add , Worksheets(Worksheets.Count)
    ActiveSheet.Name = "A0DNK5"
    Sheets("A0DNK5").Range("A1:R1").Value = Sheets("ITEX_04_2014_ADR2").Range("A1:R1").Value
     
    Dim i As Long
    Dim j As Integer
     
    Dim sh As Worksheet
    Dim feuillePrincipale As Worksheet
    Dim dnk3Sheet As Worksheet
    Dim dnk5Sheet As Worksheet
     
    Set feuillePrincipale = ThisWorkbook.Sheets("ITEX_04_2014_ADR2")
    Set dnk3Sheet = ThisWorkbook.Sheets("A0DNK3")
    Set dnk5Sheet = ThisWorkbook.Sheets("A0DNK5")
     
     
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name = "A0DNK3" Then
        i = 2
        j = 2
            While Not IsEmpty(feuillePrincipale.Cells(i, 1))
                If feuillePrincipale.Cells(i, 4).Value = "A0DNK3" Then
                feuillePrincipale.Cells.Rows(i).EntireRow.Copy dnk3Sheet.Rows(j)
                j = j + 1
                End If
            i = i + 1
            Wend
        End If
        If sh.Name = "A0DNK5" Then
        i = 2
        j = 2
            While Not IsEmpty(feuillePrincipale.Cells(i, 1))
                If feuillePrincipale.Cells(i, 4).Value = "A0DNK5" Then
                feuillePrincipale.Cells.Rows(i).EntireRow.Copy dnk5Sheet.Rows(j)
                j = j + 1
                End If
            i = i + 1
            Wend
        End If
    Next
     
        Application.ScreenUpdating = True
     
    End Sub
    Merci d'avance

    Bien cordialement,
    Christophe

  2. #2
    Membre Expert Avatar de Thautheme
    Homme Profil pro
    salarié
    Inscrit en
    Août 2014
    Messages
    1 373
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : salarié

    Informations forums :
    Inscription : Août 2014
    Messages : 1 373
    Par défaut
    Bonjour Christophe, bonjour le forum,

    Comment s'appelle l'onglet que tu filtres ?

  3. #3
    Membre averti
    Homme Profil pro
    Étudiant
    Inscrit en
    Février 2014
    Messages
    53
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Février 2014
    Messages : 53
    Par défaut
    Bonjour Thautheme,

    Je filtre a partir du premier onglet, soit : ITEX_04_2014_ADR2

  4. #4
    Membre Expert Avatar de Thautheme
    Homme Profil pro
    salarié
    Inscrit en
    Août 2014
    Messages
    1 373
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : salarié

    Informations forums :
    Inscription : Août 2014
    Messages : 1 373
    Par défaut
    Bonjour Bedun, bonjour le forum,

    Le code ci-dessous devrait convenir :

    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
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    Sub Funds()
    Dim OS As Object 'déclare la variable OS (Onglet Source)
    Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
    Dim PL As Range 'déclare la variable PL (PLage)
    Dim D As Object 'déclare la variable D (Dictionnaire)
    Dim CEL As Range 'déclare la variable CEL (CELlule)
    Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
    Dim I As Long 'déclare la variable I (Incrément)
    Dim PLV As Range 'déclare la variable PLV (PLage Visible)
    Dim OD As Object 'déclare la variable OD (Onglet Destination)
    Dim DEST As Range 'déclare la variable DEST (cellule DESTination)
     
    Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
    Set OS = Sheets("ITEX_04_2014_ADR2") 'définit l'onglet source OS
    DL = OS.Cells(Application.Rows.Count, 4).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 4 (=D) de l'onglet OS
    Set PL = OS.Range("D2:D" & DL) 'définit la palge PL
    Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
    For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
        D(CEL.Value) = "" 'alimente le dictionnaire D
    Next CEL 'prochaine cellule de la boucle
    TMP = D.keys 'récupère dans la tableau temporaire TMP les éléments uniques (sans doublon) du dictionnaire D
    For I = 0 To UBound(TMP) 'boucle sur tous les éléments uniques du tableau temporaire TMP
        OS.Range("D1").AutoFilter Field:=4, Criteria1:=TMP(I) 'filtre la colonne 4 (=D) de l'onglet OS avec TMP(I) comme critère
        Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV (cellules visibles, non filtrées, de la plage PL)
        On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
        Set OD = Sheets(TMP(I)) 'définit l'onglet destination OD (génère une erreur si cet onglet n'existe pas)
        If Err <> 0 Then 'condition : si une erreur a été générée
            Err.Clear 'efface l'erreur
            Sheets.Add after:=Sheets(Sheets.Count) 'ajoute un onglet en dernière position
            ActiveSheet.Name = TMP(I) 'renomme l'onglet avec TMP(I) comme nom
            Set OD = ActiveSheet 'définit l'onglet destination OD
        End If 'fin de la condition
        On Error GoTo 0 'annule la gestion des erreurs
        OS.Range("A1:R1").Copy OD.Range("A1") 'copie la ligne des étiquettes
        Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
        PLV.EntireRow.Copy DEST 'copie les lignes entières de la plage PLV dans DEST
        OS.Range("D1").AutoFilter 'supprime le filtre automatique
    Next I 'prochain élément de la boucle
    Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
    End Sub

  5. #5
    Membre averti
    Homme Profil pro
    Étudiant
    Inscrit en
    Février 2014
    Messages
    53
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Février 2014
    Messages : 53
    Par défaut
    re,

    C'est un peu complique pour mon niveau.

    J'ai plusieurs questions si tu as le temps :

    J'ai un depassement de capacite, mon tableau fait plus de 150 000 lignes. Du coup cette partie de code ne marche pas mais je pense pouvoir m'en sortir pour ce soucis

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    DL = OS.Cells(Application.Rows.Count, 4).End(xlUp).Row
    Dans cette ligne je dois ajouter mes criteres a la placde de TMP (I) ?
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    OS.Range("D1").AutoFilter Field:=4, Criteria1:=TMP(I)
    Quelque chose de ce genre:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    OS:Range("D1").AutoFilter Field:=4, Criteria1:="A0DNK3", Operator:=xlOr, Criteria2:="A0DNK5", Operator:=xlOr, Criteria3:="A0DNK7"
    Petit soucis ca ne passe pas avec plus de 2 criteres, fin d'apres ce que j'ai pu lire....

    J'utilise cette partie de code pour nommmer tous les onglets correspondants a mes criteres ?
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    ActiveSheet.Name = TMP(I)
    Merci pour ta patience

    a+

  6. #6
    Membre Expert Avatar de Thautheme
    Homme Profil pro
    salarié
    Inscrit en
    Août 2014
    Messages
    1 373
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : salarié

    Informations forums :
    Inscription : Août 2014
    Messages : 1 373
    Par défaut
    Bonjour Nubed, bonjour le forum,

    En dehors de ton premier soucis, qui sera résolu par Dim DL As Long à la place de Dim DL as Integer...
    Sinon le code que je te propose n'a pas besoin de modifications, il devrait fonctionner tout seul.
    • Les critères sont stockés dans le tableau TMP (quel que soit le nombre)
    • une boucle filtre ensuite l'onglet source pour chaque critère, un onglet destination est crée (si il n'existe pas déjà) et la plage filtrée est copié dans cet onglet destination...

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2007] Utilisation du ruban via Macro (onglet Excellent Analytics)
    Par Kimy_Ire dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 05/11/2013, 18h08
  2. Optimisation macro comparaison / Plantage
    Par Geoffray69 dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 22/07/2013, 10h00
  3. [XL-2007] Optimisation macro ?
    Par lecter85 dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 10/01/2013, 08h49
  4. optimisation macro de traitement d'un fichier de données
    Par jalinn dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 06/07/2008, 20h00
  5. {VBA Excel} Optimiser macro si possible
    Par Thomas69 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 05/06/2007, 16h06

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