Code très lent avec boucle while

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour j'ai une lenteur inimagnable (5 seconde) avec ce code, quelqu'un voit l'erreur par pur hasard ?

' Fonction qui change des que tu change la colonne

Code:

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
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
 
Dim iENT As Integer
Dim iRET As Integer
Dim ENT As Worksheet
Dim RET As Worksheet
 
Set ENT = Worksheets("ENT_BET")
Set RET = Worksheets("Retenue")
 
 
    ' NETOYER LA PLAGE RETENUE
    Worksheets("Retenue").Range("A3:G150").Clear
    ' NETOYER LA PLAGE AMT
    If Target.Column = 6 Then
        iRET = 3
        iENT = 3
        While ENT.Cells(iENT, 6).Value <> ""
 
 
            If ENT.Cells(iENT, 6).Value = "Oui" Then
                 'Copier dans retenue
                ENT.Range(iENT & ":" & iENT).Copy RET.Cells(iRET, 1)
                iRET = iRET + 1
 
                 'TODO Copier dans AMT
 
 
            End If
            'Copi
            iENT = iENT + 1
        Wend
 
        Application.CutCopyMode = False
 
 
  End If
    Application.EnableEvents = True
End Sub

03/06/2019, 14h56
Jean-Philippe André

Salut,

manipuler des cellules dans le worksheet_change, c'est pas l'idéal, aussi il faudrait a minima désactiver les évènements, ce que tu as fait, mais il y a également des problématiques de calculs, avec des formules dans tous les sens...
03/06/2019, 14h57
Allan06

Bonjour,

Ton code s'exécute à chaque fois que tu changes de cellule avec une boucle while ?! Obligé d'avoir While dans ton code ?
Peux-tu expliquer ce que tu tentes de faire ?
03/06/2019, 14h58
Invité

Ca sert juste a ne pas aller jusqu'a la dernière colonne d'excel 129000 où un truc du genre donc c'est pour juste copier la derniere ligne non vide
sauf erreur de ma part
03/06/2019, 15h02
Allan06

Tu veux copier la dernière ligne en te basant sur une colonne ?
Peux-tu donner un exemple avec une capture d'écran ?
03/06/2019, 15h06
Invité

1 pièce(s) jointe(s)

Bonjour oui bien sur !

Je t'ai fait un exemple dans la capture d’écran ci-dessous,
en fait des que quelqu'un se met sur la colonne 6 le code s'execute
Pièce jointe 480373
Dans l'objectif de copier tous dans l'autre feuille pour continuer uniquement avec les entreprises retenues
03/06/2019, 15h10
Allan06

Tu es obligé de passer par un SelectionChange ? Tu ne peux pas créer un bouton qui copie tout dans une autre feuille et vire tout ce qui n'est pas "retenue : oui" ?
03/06/2019, 15h15
Invité

Bonjour Allan,

Oui j'ai d'ailleurs réfléchi a cela, mais je voyait pas mettre quoi dans la macro justement (sachant que le personnel peut changer d'avis et dans ce cas la la feuille suivante doit-être mise a jour
03/06/2019, 15h24
Allan06

Et si tu faisais une feuille base de données où tu as toutes tes lignes, puis avec une macro, te sort une nouvelle feuille seulement avec les "oui", s'il y a.
Au final, si un "non" devient "oui", ça sortira aussi.

Qu'en penses-tu ?
03/06/2019, 15h29
Invité

Le problème c'est que toutes les autres feuilles sont relié a cette feuile RETENUE, par exemple dans AMT (je reprends les colonne A B et C mais via la formule =Retenue!A1 etc) de même pour suivi PA,

Si je Creer une feuille pourrais-je laisser ces formules commes elles sont ?

Et si oui comment faire ?

Merci d'avance Allan
03/06/2019, 15h32
Allan06

Tu peux avoir ta base de données (par exemple cette feuille) et demander, lorsque tu cliques sur un bouton, te créer une nouvelle feuille avec les lignes "oui" uniquement.
Ainsi, les formules de AMT recherche toujours dans ta base de données et tu as une nouvelle feuille dite de synthèse (Feuille "retenue").

Si tu effaces une lignes dans cette feuille, au final dans AMT, tu as un problème nan ?
03/06/2019, 15h34
Invité

Pour l'instant non, ca s'efface directement sur AMT, chose que je veux du coup

Pour le coup comment je m'y prends pour creer une feuille a partir d'un oui ?
03/06/2019, 15h39
Allan06

Ce qu'il est possible de faire :

Avoir une feuille base de données (feuille ENT_BET)
Une macro qui copie uniquement les lignes "oui" pour te les mettre dans la feuille "Retenue"
Les formules de ta feuille AMT ne bougent pas et restent les mêmes !

Au final à chaque fois que tu auras terminé de saisir tes infos dans ENT_BET, tu pourras lancer la macro qui récupère que les "oui" et ainsi dans "Retenue" tu auras la synthèse de tous tes "oui".

Est-ce que tu souhaites ?
03/06/2019, 15h42
Invité

Oui, c'est exactement ce que je veux en fait! Mais le problème c'est que je suis débutant encore en VBA donc je ne vois pas trop la macro .

Mais oui en fait l'idée est là
03/06/2019, 15h44
Invité

1 pièce(s) jointe(s)

Je te montre juste a quoi ressemble ma feuille retenue:
Pièce jointe 480383

Pour la macro, elle est à mettre dans un module.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Option Compare Text
Sub NomMacro()
Application.ScreenUpdating = False
Dim NbYes As Integer
Dim Debut, Fin as Long
Sheets("ENT_BET").Activate
NbYes = Application.WorksheetFunction.CountIf(Columns("F"), "Oui")
Select Case NbYes
Case Is > 0
    'On nettoie la feuille retenue
    Sheets("Retenue").Activate
    Range("A3", "D100000").Clear
    Sheets("ENT_BET").Activate
    'On demande un tri sur la colonne F
    Range("A2").CurrentRegion.Sort _
    key1:=Range("F1"), order1:=xlDescending, dataoption1:=xlSortNormal, Header:=xlYes
    Debut = Columns("F").Find("Oui", , xlValues, xlWhole).Row
    Fin = Debut + NbYes - 1
    Union(Range(Cells(Debut, 1).Address, Cells(fin, 3).Address), Range(Cells(Debut, 7).Address, Cells(fin, 7).Address)).Copy
    Sheets("Retenue").Activate
    Range("A3").PasteSpecial xlPasteValues
End Select
End Sub

J'ai enlevé volontairement la colonne "Entreprises retenues" de la feuille "Retenue", car l'information n'est pas nécessaire.
Dis-moi si cela fonctionne pour toi.

PS : N'oublies pas d'enlever le SelectionChange

03/06/2019, 16h16
Invité

Rebonjour Allan !
Déja je te remercie avant tout de ton aide !

J'ai copié cela dans un module du fichier et j'ai supprimé du coup ce qui y'avait dans mon Worksheet change pour voir ce que ca donnait
mais du coup rien ne se passe (enfin jeveux dire rien n'est copié dans la feuille retenue)
03/06/2019, 16h17
Allan06

As-tu créé un bouton pour affecter ta macro puis la lancer ?
Ici, la macro n'est pas exécutée lorsqu'un évenement se passe mais quand on demande de la lancer via bouton ou raccourci clavier.
03/06/2019, 16h20
Invité
On me dit erreur dans la ligne :
Code:

1 2 Range("A2").CurrentRegion.Sort _ key1:=Range("F1"), order1:=xlDescending, dataoption1:=xlSortNormal, Header:=xlYes
Apparemment la méthode Sort de la classe range a échoué
03/06/2019, 16h22
Allan06

Peux-tu envoyer ton fichier que je puisse trouver le problème ?

Voir 40 message(s) de cette discussion en une page