Rapidité fct VBA en Private Sub sur tableau 1000 lignes

Bonjour,

ATTENTION SUJET POUR GROS BALEZE D'EXCEL

J'ai un gros problème sur le fichier que je vais vous joindre en dessous..

Premièrement mes fonctions fonctionnent !! Seulement, elles sont bien pour un tableau de 20 à 30 lignes pas plus.... Elles doivent tourner dans un tableau qui est ammené à faire 1000 lignes alors que là à 100 lignes tout plante et tout rame....

Les différentes macros :

Onglet 1

1) J'ai une grosse macro dans le premier onglet qui, lorsqu'il voit un un statut marqué ACTIF en case I copie la ligne à la suite des autres dans l'onglet 2.

2) Cette même macro met à jour les champs de M à U des lignes correspondantes (de l'onglet 1 vers l'onglet 2)

Problème de cette macro :

Le soucis premier est qu'au lieu de copier juste une nouvelle ligne (de l'onglet 1 vers l'onglet 2), elle copie le tableau entier !!

>>>premier ralentissement

Onglet 2

Dans cette onglet, les copies arrivent grâce à la macro expliqué ci-dessus.

Puis :

1) Je compare la colonne I pour trouver les éventuelles ocurances et les supprime.

2) Dans le cas d'une suppression j'ai des lignes vides en plein milieu du tableau donc je remonte les lignes du dessous au bon endroit.

Problème de cette macro :

Le problème est que la comparaison des lignes 1 par 1 est relativement longue.

De plus, lorsque je replace mes lignes, chaque ligne est déplacée une par une ligne par ligne......

>>>Et Biiim gros ralentissement !!!

A savoir

Un bouton "Copie vers REX" est présent n'en tenez pas compte vue que c'est pour l'instant la solution de dépannage...

Toutes les fonctions doivent tourner sans bouton !!

Le critère des doublons ne doit s'effectuer QUE en colonne Idans le deuxième onglet.

Utilisation du tableau

Il vous suffit d'actualiser le tableau, donc de double cliquer en colonne B sur un numéro puis d'appuyer sur Entrée.

Ensuite allez voir dans l'onglet REX et regarder les macros de cette page (qui ici sont en Sub pour ne pas tout planter)

Si vous avez le courage de m'aider et de vous attaquer à ce problème merci beaucoup !!!!!

Je ne peux pas joindre mon fichier je ne sais pas pourquoi....


Bon bah je ne peux pas copier mon fichier.....Lorsque je clique sur ajouter la page s'actualise mais le fichier n'est pas ajouté....

Donc voici les codes

Onglet 1:

Option Explicit

Dim i As Long, ligne As Long
Dim wb_dep As String
Dim derLn, cell

Private Sub Worksheet_change(ByVal Target As Range)

    Application.ScreenUpdating = False
    derLn = Range("A" & Rows.Count).End(xlUp).Row
    wb_dep = ActiveWorkbook.Name

    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B5:B" & derLn)) Is Nothing Then

        'Copie des lignes avec conditions
        ligne = Sheets("REX").Range("K" & Sheets("REX").Rows.Count).End(xlUp).Row
        If ligne < 5 Then ligne = 5 Else ligne = ligne + 1
            For i = 5 To Workbooks(wb_dep).Sheets(1).Range("A" & Workbooks(wb_dep).Sheets(1).Rows.Count).End(xlUp).Row
                If Workbooks(wb_dep).Sheets(1).Range("K" & i) = "ACTIF" Then
                        Workbooks(wb_dep).Sheets(1).Range("A" & i & ":U" & i).Copy
                        Workbooks(wb_dep).Sheets(2).Range("A" & ligne).PasteSpecial Paste:=xlValues
                    ligne = ligne + 1
                End If
            Next i
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    ElseIf Not Intersect(Target, Union(Range("A6:A" & derLn), Range("C6:U" & derLn))) Is Nothing _
            And Cells(Target.Row, "B") <> "" Then
        Set cell = Sheets("REX").Range("B:B").Find(Range("B" & Target.Row), lookat:=xlWhole)
        If Not cell Is Nothing Then
            Workbooks(wb_dep).Sheets(1).Range("A" & Target.Row & ":U" & Target.Row).Copy
            Workbooks(wb_dep).Sheets(2).Range("A" & cell.Row).PasteSpecial Paste:=xlValues
        End If
    End If
    Application.CutCopyMode = False
End Sub

Onglet 2

Sub Doublons()

Dim DernLigne As Long
DernLigne = Range("A65536").End(xlUp).Row

'Suppression des doublons
For a = 5 To DernLigne
compteur = 0
    If Cells(a, 9) <> "" Then
        For b = 5 To DernLigne
            If Cells(b, 9).Value = Cells(a, 9).Value Then
                compteur = compteur + 1
                If compteur > 1 Then Cells(b, 9).EntireRow.ClearContents
            End If
        Next b
    End If
Next a
End Sub

Sub Replacer()

Dim DernLigne As Long
DernLigne = Range("A65536").End(xlUp).Row

' suppression des trous
For a = 5 To DernLigne
    If Cells(a, 1) = "" Then
        If Cells(a + 1, 1) <> "" Then
            Range(Cells(a + 1, 1), Cells(a + 1, 21)).Copy
            Cells(a, 1).PasteSpecial xlPasteValues
            Cells(a + 1, 1).EntireRow.ClearContents
            a = a - 2
        End If
    End If
Next a

End Sub

Bonsoir,

le site limite la taille des fichiers à 300 Ko.

Vous pouvez essayer "Ci-joint.com" ou FR je ne sais plus

@ bientôt

LouReeD

Bonjour,

Utilise http://cjoint.com pour communiquer ton fichier.

Ta 1re macro a l'air à peu près bien écrite, mais à y regarder de près elle n'a que l'air !

J'ai fait quelques bonds à la lecture et je me suis interrompu... On ne devrait pas avoir de difficulté à faire quelque chose d'un peu plus satisfaisant.

Les 2 autres plus cohérentes, mais je conçois qu'elles puissent ne pas vraiment donner satisfaction. Mais on peut aussi procéder autrement.

Cordialement.

Bonjour,

Merci pour l'info du lien Cjoint c'est superbe !! =)

Du coup voici le lien de mon fichier:

https://www.cjoint.com/c/FBmhnuz2HZk

Merci d'avance !!

La procédure qui te pose le premier problème se déclenche à chaque fois que tu interviens en colonne B.

Il me semble bien avoir vu que la condition d'insertion sur REX était la mention ACTIF en colonne K.

Il serait plus rationnel qu'elle intervienne lors d'un changement en colonne K.

A ce stade, 2 questions complémentaires :

1) Une fois que ACTIF a été porté en col. K, est-il possible que l'on revienne à un statut autre que ACTIF ?

Et dans ce cas la ligne doit-elle être ôtée de REX ?

2) Est-ce que lorsque la ligne a été insérée en K (ACTIF), elle est complète et il n'y a plus à lui apporter de modifications par la suite ?

3) (en complément : est-ce que ta base est triée, tant sur DT-OT que sur REX ? Et alors sur quel critère ?

A te lire.

MFerrand a écrit :

1) Une fois que ACTIF a été porté en col. K, est-il possible que l'on revienne à un statut autre que ACTIF ?

Et dans ce cas la ligne doit-elle être ôtée de REX ?.

Tout d'abord, concernant le REX rien ne doit disparaitre !! En fait pour t'éclaircir, REX signifie Retour d'EXpérience. Et chaque ligne représente une activité l'onglet REX est donc un onglet "hystorique".

Ensuite, le statut ACTIF n'est pas appliqué à la main, il est importé par formule qui exploite un lourd tableau (l'onglet BI) qui est une base de donnée régulièrement mis à jour. Et le statut ne change pas.

MFerrand a écrit :

2) Est-ce que lorsque la ligne a été insérée en K (ACTIF), elle est complète et il n'y a plus à lui apporter de modifications par la suite ?

Lorsque tu inscrit un numéro en B (onglet DT-OT) toutes les infos sont importées (à noter que le numéro inscrit correspond à un numéro de l'onglet BI et qui termine par un espace sinon ça ne marche pas...). Le statut est donc importé et s'il est ACTIF elle est copiée en REX et oui des infos sont apportées après la copie en colonne M à U.

MFerrand a écrit :

3) (en complément : est-ce que ta base est triée, tant sur DT-OT que sur REX ? Et alors sur quel critère ?

Et enfin non les bases ne sont pas triés..et si on peux trier ou si c'est nécessaire le tri serait par date. Du plus récent au plus ancien.

EDIT 09:22 ------------------------------------------------

Merci beaucoup de ton implication et de ton aide MFerrand !!!!

J'ingère tout ça ! Et je commence par un café !

Donc OK pour B, saisie manuellement, mais on ne reprendra que la ligne.

Et inutile de tester ensuite de C à U si les infos ultérieures n'interviennent que de M à U.

A+

Voilà le premier volet à tester.

On n'introduit que la ligne nouvelle ou on modifie la ligne modifiée.

Technique un peu différente de la précédente utilisée (en dehors du fait qu'elle refaisait tout le tableau) : on ne copie plus, on affecte les valeurs de la ligne à ajouter à une nouvelle ligne de REX (en passant par une variable plage pour plus de commodité).

J'ai maintenu le test de recherche de ligne sur REX sur la colonne K. Il aurait été plus logique de le faire sur B (qui est la source du déclenchement, cependant il apparaît B n'est pas toujours servie sur REX, ce qui me paraît être une anomalie compte tenu de ta réponse précédente.

Avant de m'attaquer au second volet, j'ai noté que les doublons étaient appréciés sur la colonne I. Pareil, cela ne me paraît pas très logique car ils devraient également s'apprécier sur B. Mais cela repose le problème des valeurs B manquantes dans REX ?

Enfin, ces procédures ne sont pas évènementielles et n'ont rien à faire dans un module de feuille. Elles doivent être déplacées dans un module standard. Comment entends-tu les lancer ? Faut-il prévoir un bouton sur REX pour cela ?

Cordialement.

https://www.cjoint.com/c/FBmjVc5PFCy

Voilà le premier volet à tester.

Décidémment, je ne tombe que sur des pros sur ce forum vous êtes trop fort !! ^^

Se que tu as fait est nickel et très rapide même avvec plein de lignes c'est donc parfait !! Merci beaucoup !!!

Il aurait été plus logique de le faire sur B (qui est la source du déclenchement, cependant il apparaît B n'est pas toujours servie sur REX, ce qui me paraît être une anomalie compte tenu de ta réponse précédente.

Alors oui le test se fait sur K="ACTIF" et doit le rester car des fois, nous n'avons pas de numéro à inscrire en B alors que nous avons un numéro à inscire en I qui permet également de récupérer le statut ACTIF ou non.

Et il n'y a donc pas de valeurs manquantes.

Du coup même réponse pour la question des doublons. J'ai toujours un numéro en I mais pas forcément en B donc il faut laisser comme ça.

Enfin, ces procédures ne sont pas évènementielles et n'ont rien à faire dans un module de feuille. Elles doivent être déplacées dans un module standard. Comment entends-tu les lancer ? Faut-il prévoir un bouton sur REX pour cela ?

Alors oui même si j'ai un très bas niveau en VBA je sais que ces procédures n'ont rien a faire ici en tant que Sub standart. Cependant elles étaient en évènementielles et doivent le rester !! C'est juste pour l'envoie du fichier et vous permettre de le tester que je les ai passé en sub car elles faisaient tout planter...

Encore merci !!

Dans ce cas, il y a un autre petit problème, la procédure ne se lancera pas si tu ne saisis rien en B.

Il faudrait donc tester également la saisie sur I pour la déclencher.

Ceci étant, tu peux tout de même la déclencher en éditant B et valider (= se placer dans la barre de formule et appuyer sur Entrée). Mais il faut le savoir et surtout penser à le faire systématiquement dans ce cas.

Mais le déclenchement automatique serait plus confortable, sachant que la proc. ne se lancera qu'une fois, et que la modification de I par formule ne la lancera pas.

J'attends ton avis.

Autre chose en ce qui concerne les doublons : pourquoi ne pas tester s'il y a doublon avant insertion ? Si doublon, on n'insère pas, et tu économises une recherche suplémentaire pour dédoublonner.

Tout d'abord entièrement d'accord pour tester le doublon avant l'insertion !!! Et pour le premier point je pense que dans ce cas on ajoutera en B (dans le cas d'absence de numéro) quelque chose du genre non renseigné pour actualiser.

OK, je vois ça après une douche (besoin avec 32° !), mes courses alimentaires (besoins aussi) et manger dans la foulée (décalage horaire...)

En attendant, je t'ai recomposé la macro pour dédoublonner de façon qu'elle soit un peu plus rapide. Il est toujours utile d'en garder une sous le coude en cas de besoin.

Sub SupprimerDoublonsREX()
    Dim DernLigne As Long, i As Long, plageI As Range
    DernLigne = Range("A65536").End(xlUp).Row
    With Worksheets("REX")
        Set plageI = .Range("I6:I" & DernLigne)
        For i = DernLigne To 7 Step -1
            If Application.CountIf(plageI, .Cells(i, 9).Value) > 1 _
             And .Cells(i, 9).Value <> "" Then
                .Rows(i).Delete
                .Rows(DernLigne).Insert
            End If
        Next i
    End With
End Sub

A plus tard.

Un petit contretemps en soirée...

Modifié pour prendre en compte la saisie en B ou I.

(Rien introduit en B, car il te faudrait alors modifier toutes tes formules.)

Teste si la ligne existe déjà avant insertion.

Pour les modifs M à U, la recherche de la ligne se fait sur I (B étant à trous).

Cordialement.

https://www.cjoint.com/c/FBnbN44k8py

Re !!!

J'ai pas tout compris quand tu dis "pas de saisie en B sinon c'est la cata" ?

Et pour le test je monte à Paris en ce moment même donc je peux po....

Merci beaucoup

Tes formules sont toutes bâties avec une condition ; SI(Bxx=0;... (on recherche à partir de Ixx).

Donc si on mettait quelque en B quand tu n'as pas de numéro, toutes tes formules seraient en erreur...

Bon weekend.

Aaah nan il y a les deux justement !! Les formules incluent les deux possibilités : I ou B

Oui ! Mais si B n'est plus égal à 0, la recherche ne se fait pas sur I et échoue sur B !

Rechercher des sujets similaires à "rapidite fct vba private sub tableau 1000 lignes"