optimisation d'une macro très lente

jozerebel · 7 Août 2010

Bonjour à tous!!!!

Avec l'aide de tous, en particulier papou et Pierre jean, j'ai construit un fichier me servant de suivi de prises en charge (secteur sanitaire et social).

Cependant, une macro (nommée chab sous VBA, faisant référence aux fonctions cha et chb du module 1 [merci Pierre Jean!]) met un temps fou, mais fou.... à s'exécuter.

Pour info, l'onglet A a quelques 2500 lignes, quelques 28000 lignes dans l'onglet "BDD pec".

Je joins le fichier, vide d'info, mais avec les macros... et le lien direct au cas où:

Si vous pouvez voir comment accélerer le traitement de la macro chab ...

D'avance merci!

PS : Utilisation de windows XP, office 2003 pro

JCGL · 7 Août 2010

Re : optimisation d'une macro très lente

Bonjour à tous,

Le fichier joint n'est pas fonctionnel
Le lien est OK

A+ à tous

kjin · 7 Août 2010

Re : optimisation d'une macro très lente

Bonjour, salut JC 🙂,
Pour commencer par...le commencement, je suis perplexe devant la macro et la fonction à laquelle elle fait appel

Code:

Sub chab()
'...
Range("J2").Select
        ActiveCell.FormulaR1C1 = "=cha(RC[-9],RC[-6])"
'...
End Sub

En J2 on obtient donc

Code:

=cha(A2;D2)

Puis la fonction

Code:

Function cha(client, ladate)
For n = 2 To Sheets("bdd pec").Range("A65536").End(xlUp).Row
        If Sheets("bdd pec").Range("A" & n) = client And ladate >= Sheets("bdd pec").Range("D" & n) And ladate <= Sheets("bdd pec").Range("E" & n) Then
        cha = Sheets("bdd pec").Range("D" & n)
        End If
Next n
End Function

qui revient à

Code:

=SI(ET(A2=A2;D2>=D2;D2<=E2);D2))

N'y aurait-il pas comme une erreur ?
A+
kjin

jozerebel · 7 Août 2010

Re : optimisation d'une macro très lente

Pour cette question, je te renvoie au lien des contacts avec pierre jean :

https://www.excel-downloads.com/threads/recherche-dans-un-tableau-avec-plusieurs-conditions.132714/

L'objectif est de comparer avec toutes les données de "bdd pec" pour prendre la bonne date (la plus récente si plusieurs). Il s'agit d'une boucle.

On avait bcp échangé avec lui et sa solution était opérationnelle à 100%, pas les autres.

Des idées pour m'aider?

kjin · 7 Août 2010

Re : optimisation d'une macro très lente

re,
Désolé, mais je ne vais pas me taper la lecture de 2 pages de discussion pour obtenir une réponse
J'ai lu ce qui est écrit dans ta macro et le résultat qu'elle donne, si ça te semble correct, alors je fais erreur et je passe la main
A+
kjin

pierrejean · 7 Août 2010

Re : optimisation d'une macro très lente

Bonjour jozerebel

Salut JC
Salut Kjin

IL faudrait au moins quelques exemples de données pour evaluer le temps d'execution

jozerebel · 7 Août 2010

Re : optimisation d'une macro très lente

Bonjour Pierre Jean (qui m'a déjà sauvé la vie 🙂

le lien avec le fichier et des données bidon pour test de la macro.

Cijoint.fr - Service gratuit de dépôt de fichiers

Merci pour votre aide!

jozerebel · 7 Août 2010

Re : optimisation d'une macro très lente

Voilà le lien du fichier :

Merci de votre aide.

jozerebel · 8 Août 2010

Re : optimisation d'une macro très lente

Bonjour,

après essai de la macro sur un quad core... même constat... Macro très très très lente. Et une fois sur deux, "Excel ne répond pas"....

Suis désespéré...

Any idea pour m'aider?

pierrejean · 8 Août 2010

Re : optimisation d'une macro très lente

Re

Nous sommes Dimanche et au mois d'Août !!

Je te propose la macro suivante
Inconvenients
1) Elle classe la feuille bdd pec (a noter la possibilité d'une copie préalable pour conserver l'ordre initial)
2) Elle sera a relancer pour toute modification des feuilles (a noter que lors d'une modif sur la feuille A il est possible d'utiliser Cha et chb)
Avantage:
Chez moi elle s'execute en 3 minutes
Si vraiment c'est encore trop long ,je peux regarder (mais en semaine de preference)

Code:

Sub Macro3()

    x = ActiveWorkbook.Worksheets("bdd pec").Range("A65536").End(xlUp).Row
    ActiveWorkbook.Worksheets("bdd pec").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("bdd pec").Sort.SortFields.Add Key:=Range("A2:A" & x) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("bdd pec").Sort.SortFields.Add Key:=Range("D2:D" & x) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("bdd pec").Sort
        .SetRange Range("A1:J" & x)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For n = 2 To Sheets("A").Range("A65536").End(xlUp).Row
 client = Sheets("A").Range("A" & n)
 ladate = Sheets("A").Range("D" & n)
 Set c = Sheets("bdd pec").Columns(1).Find(client, LookIn:=xlValues, lookat:=xlWhole)
 If Not c Is Nothing Then
      firstAddress = c.Address
        Do
         If c.Offset(0, 3) >= ladate And ladate <= c.Offset(0, 4) Then
          Sheets("A").Range("J" & n) = c.Offset(0, 3)
          Sheets("A").Range("K" & n) = c.Offset(0, 4)
         End If
           Set c = Sheets("bdd pec").Columns(1).FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
  End If
Next n

End Sub

jozerebel · 8 Août 2010

Re : optimisation d'une macro très lente

Bonsoir Pierre Jean!

Merci pour votre travail.

je teste cela de suite etr vous tiens informé.

Et bonne fin de dimanche!

jozerebel · 8 Août 2010

Re : optimisation d'une macro très lente

Hello Pierre Jean,

ça prend en effet bcp moins de temps!!!

Mais par contre, certaines cellules ne se remplissent pas... Sans que je puisse l'expliquer..

Par exemple J8:K13 = rien...

Et ça se reproduit tout au long de la feuille...

Des explications?

Merci encore pour votre aide et le temps passé.

Bonne soirée Pierre Jean.

jozerebel · 8 Août 2010

Re : optimisation d'une macro très lente

Hello Pierre Jean,

ça prend en effet bcp moins de temps!!!

Mais par contre, certaines cellules ne se remplissent pas... Sans que je puisse l'expliquer..

Par exemple J8:K13 = rien...

Et ça se reproduit tout au long de la feuille...
D'autre part, les résultats données sont parfois erronés... et différents de ceux que j'obtiens avec les formules cha et chb...

Voilà ce que j'attends de cha et de chb:
dans l'onglet A, j'ai des mois de facturation. Je dois rehercher à quelle période de prise en charge correspond chaque mois de facturation. Si plusieurs périodes peuvent correspondre, alors, je dois prendre celle qui a le mois de début le plus récent. Ainsi, toutes les cellules devraient être remplies.

Merci encore pour votre aide et le temps passé.

Bonne soirée.
.

pierrejean · 9 Août 2010

Re : optimisation d'une macro très lente

Re

Il est bon que tu ais rappelé ce que tu attends
Le classement de la feuille etait fait en ascendant pour la date en colonne D alors qu'il doit etre en descendant
Voici la macro qui devrait aller mieux
Toutefois ,il restera des vides notamment lorsque le nom en feuille A n'existe pas en feuille bdd pec
Veux-tu controler et me tenir informé

Code:

Sub Macro3()
debut = Timer
    x = ActiveWorkbook.Worksheets("bdd pec").Range("A65536").End(xlUp).Row
    ActiveWorkbook.Worksheets("bdd pec").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("bdd pec").Sort.SortFields.Add Key:=Range("A2:A" & x) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("bdd pec").Sort.SortFields.Add Key:=Range("D2:D" & x) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("bdd pec").Sort
        .SetRange Range("A1:J" & x)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For n = 2 To Sheets("A").Range("A65536").End(xlUp).Row
 client = Sheets("A").Range("A" & n)
 ladate = Sheets("A").Range("D" & n)
 Set c = Sheets("bdd pec").Columns(1).Find(client, LookIn:=xlValues, lookat:=xlWhole)
 If Not c Is Nothing Then
      firstAddress = c.Address
        Do
         If c.Offset(0, 3) >= ladate And ladate <= c.Offset(0, 4) Then
          Sheets("A").Range("J" & n) = c.Offset(0, 3)
          Sheets("A").Range("K" & n) = c.Offset(0, 4)
         End If
           Set c = Sheets("bdd pec").Columns(1).FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
  End If
Next n
MsgBox (Timer - debut)
End Sub

jozerebel · 9 Août 2010

Re : optimisation d'une macro très lente

Bonjour Pierre Jean!

Merci encore pour ta rapidité.

J'ai essayé de tester cela mais j'obtiens une erreur d'execution 438 sur la ligne ActiveWorkbook.Worksheets("bdd pec").Sort.SortFields.Clear

Dois-je activer quelquechose sur Excel?

Merci encore pour ton aide.

optimisation d'une macro très lente

jozerebel

XLDnaute Occasionnel

Pièces jointes

JCGL

XLDnaute Barbatruc

kjin

XLDnaute Barbatruc

jozerebel

XLDnaute Occasionnel

kjin

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

jozerebel

XLDnaute Occasionnel

jozerebel

XLDnaute Occasionnel

jozerebel

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

jozerebel

XLDnaute Occasionnel

jozerebel

XLDnaute Occasionnel

jozerebel

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

jozerebel

XLDnaute Occasionnel

optimisation d'une macro très lente

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Privacy & Transparency

Privacy & Transparency