Macro remplace formule trop longue mais pb temps

Marion · 29 Février 2008

Bonjour le forum,
j'avais besoin de trier une base de données en supprimant des lignes inutiles.
Je pense isoler ces lignes en ajoutant à côté de chaque ligne "OUI" ou "NON" si c'est une ligne à conserver ou non. Au départ je pensais mettre une formule classique ( si(cnum(gauche(d1;1)= 607.... seulement ma formule était trop longue pour être transcrite dans ma macro.
J'ai donc été obligée de créer des boucles en vba. Cela fonctionne très bien seulement comme il y a 18000 lignes à traiter et que mes boucles doivent 'analyser' chaque ligne, cela prend un temps fou (15 bonnes minutes) alors même si le résultat correspond à ce que je veux j'aimerais savoir si vous auriez une solution alternative à ce petit casse-tête.

J'ai remplacé ces lignes qui bug :

Code:

[COLOR="Blue"][B][I][B]ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>0,IF(LEFT(RC[-9]=""0"",IF(VALUE(LEFT(RC[-9],3))=66,""OUI"",""NON""),IF(OR(AND(607<VALUE(RC[-9],3)),VALUE(LEFT(RC[-9],3))<700),VALUE(LEFT(RC[-9],3))>709),IF(OR(VALUE(RC[-9],2))=75,VALUE(LEFT(RC[-9],2))=76,VALUE(LEFT(RC[-9],3))=771,VALUE(LEFT(RC[-9],3))=609,VALUE(LEFT(RC[-9],3))=675,VALUE(LEFT(RC[-9],3))=676,VALUE(LEFT(RC[-9],3))=671,VALUE(LEFT(RC[-9],3))=772,VALUE(LEFT(RC[-9],3))=775,VALUE(LEFT(RC[-9],1))=8,VALUE(LEFT(RC[-9],1))=9),""NON"",""OUI""),""NON"")),""NON"")"
       '"=IF(OR(LEFT(RC[-9],2)=""06"",LEFT(RC[-9],2)=""07"",LEFT(RC[-9],1)=""6"",LEFT(RC[-9],1)=""7""),""OUI"",""NON"")"
    Range("M1").Select
    Selection.AutoFill Destination:=Range("M1:M" & dligne2 - 1)[/B][/I][/B][/COLOR]

Par ces boucles :

Code:

[COLOR="blue"][I][B][B]For y = 1 To dligne2 - 1
    If ActiveSheet.Range("L" & y).Value = 0 Then
        ActiveSheet.Range("M" & y) = "NON"
        Else
            If Left(ActiveSheet.Range("D" & y).Text, 1) = "0" Then
                If Left(ActiveSheet.Range("D" & y).Value, 3) = 66 Then
                ActiveSheet.Range("M" & y) = "OUI"
                Else
                ActiveSheet.Range("M" & y) = "NON"
                End If
            Else
                If Left(ActiveSheet.Range("D" & y).Value, 3) > 607 And Left(ActiveSheet.Range("D" & y).Value, 6) <= 649000 Or Left(ActiveSheet.Range("D" & y).Value, 6) > 740000 And Left(ActiveSheet.Range("D" & y).Value, 6) <= 741113 Then
                    If Left(ActiveSheet.Range("D" & y).Value, 3) = 609 Or Left(ActiveSheet.Range("D" & y).Value, 6) = 633000 Or Left(ActiveSheet.Range("D" & y).Value, 6) = 633001 Or Left(ActiveSheet.Range("D" & y).Text, 7) = "634010F" Or Left(ActiveSheet.Range("D" & y).Value, 3) = 641 Or Left(ActiveSheet.Range("D" & y).Value, 3) = 646 Then
                    ActiveSheet.Range("M" & y) = "NON"
                    Else
                    ActiveSheet.Range("M" & y) = "OUI"
                    End If
                Else
                    If Left(ActiveSheet.Range("D" & y).Value, 3) = 673 Or Left(ActiveSheet.Range("D" & y).Value, 3) = 690 Or Left(ActiveSheet.Range("D" & y).Value, 6) = 747902 Or Left(ActiveSheet.Range("D" & y).Value, 6) = 749000 Or Left(ActiveSheet.Range("D" & y).Value, 3) = 773 Then
                    ActiveSheet.Range("M" & y) = "OUI"
                    Else
                    ActiveSheet.Range("M" & y) = "NON"
                    End If
                End If
            End If
    End If
Next y[/B][/B][/I][/COLOR]

J'espère que vous pourrez m'aider

En vous remerciant

Marion

Cousinhub · 29 Février 2008

Re : Macro remplace formule trop longue mais pb temps

Bonjour,
peux-tu éditer ton message, et mettre le code entre bornes (le # en haut)
Tu auras :

Code:

[COLOR="Red"]ICI[/COLOR]

Insère ton code dedans, ça évitera d'acheter une Télé 114 cm pour lire le msg

SergiO · 29 Février 2008

Re : Macro remplace formule trop longue mais pb temps

Bonjour Marion,

Je n'ai pas pris le temps de décomposer ton code mais as-tu mis cette ligne au début de ton code?

Code:

Application.Screenupdating = False

@+

Marion · 29 Février 2008

Re : Macro remplace formule trop longue mais pb temps

Merci beaucoup Sergio pour ta réponse en effet, ça diminue un peu le temps mais malheureusement pas de beaucoup....

Cousinhub · 29 Février 2008

Re : Macro remplace formule trop longue mais pb temps

Bonjour,
et excuse pour le trait d'humour , mais c'est quand même plus facile à lire

Petite question : tes valeurs 0 en colonne "L" sont-elles issues de formules ou sont-ce des cellules vides, ou écrites à la main?

Marion · 29 Février 2008

Re : Macro remplace formule trop longue mais pb temps

Tu as raison c'est plus facile à lire comme ça

En fait la colonne L de ma base de données est consituée de valeurs numériques, pas de formules, pas vides

Cousinhub · 29 Février 2008

Re : Macro remplace formule trop longue mais pb temps

Re,
autre question

que fais-tu des lignes comportant des 0? (supprimées, préservées)?

dans ton code, tu mets si la valeur de Lx est 0, alors Mx est "NON"
Faut-il conserver les "NON" ou les supprimer

PS, après ce traitement, il y aura d'autres questions, ne t'inquiètes pas

Edit : en supplément, pourrais-tu joindre un fichier exemple, ôté de données confidentielles, mais avec la colonne L, pour voir la structure?

Marion · 10 Mars 2008

Re : Macro remplace formule trop longue mais pb temps

Merci bhbh pour ton intérêt
Bonjour le forum

Je réponds tard mais j'ai mis un peu de temps à préparer mon fichier test

Bon il y a l'idée. Dans mon fichier lorsque vous cliquez sur le bouton Import la macro traite les données collées dans l'onglet Import.
Tout fonctionne bien .
Le problème est que dans le vrai fichier il y a 20 000 lignes. Et comme la procédure veut que le test OUI/NON se fasse sur chaque ligne, la macro dure 20 minutes.....

J'espère que vous pourrez m'aider.
Merci encore Marion

Marion · 13 Mars 2008

Re : Macro remplace formule trop longue mais pb temps

Bonjour le forum,
je me permets d'insister car je n'ai vraiment aucune piste et je pense que quelqu'un a déjà du rencontrer ce genre de problème.

Est ce que les filtres élaborés fonctionnent en vba ?? Sont-ils faciles à utiliser en vba ?

Parce que cela pourrait peut-être être une solution...

J'espère que vous pourrez m'aider, Marion

pierrejean · 13 Mars 2008

Re : Macro remplace formule trop longue mais pb temps

bonjour Marion

Une premiere approche en utilisant un tableau

Vois si l'on obtient un gain de temps

J'essaie de generaliser le tableau plus encore mais mes vieux neurones renaclent

pierrejean · 13 Mars 2008

Re : Macro remplace formule trop longue mais pb temps

Re

meilleure version en ce qui me concerne

mais difficile d'evaluer sur le seul exemple

Guest · 13 Mars 2008

Re : Macro remplace formule trop longue mais pb temps

oui, PierreJean la solution fait sûrement gagné du temps.

Je rajouterai en début de macro:

Code:

Dim ModeCalcul
With Application
    ModeCalcul = Application.Calculation
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

On Error GoTo FinImport

et en fin de macro pour rétablir:

Code:

FinImport:
With Application
    .Calculation = ModeCalcul
    .EnableEvents = True
    .ScreenUpdating = True
End With

Ce qui fait parfois gagner quelques secondes, les recalculs du classeur et évènements de feuille étant désactivés.

Bonne soirée

Marion · 14 Mars 2008

Re : Macro remplace formule trop longue mais pb temps

Merci beaucoup Pierrejean !!!!!!! C incroyable, ça ne met que quelques secondes...........je ne comprends pas comment ça fonctionne pour quelles raison ça prend moins de temps. Je n'y aurais jamais pensé.

Merci Merci Merci

Je vais vérifier si ça traite bien tout comme je veux mais ça m'a l'air nickel.

Macro remplace formule trop longue mais pb temps

Marion

XLDnaute Junior

Cousinhub

XLDnaute Barbatruc

SergiO

XLDnaute Accro

Marion

XLDnaute Junior

Cousinhub

XLDnaute Barbatruc

Marion

XLDnaute Junior

Cousinhub

XLDnaute Barbatruc

Marion

XLDnaute Junior

Pièces jointes

Marion

XLDnaute Junior

pierrejean

XLDnaute Barbatruc

Pièces jointes

pierrejean

XLDnaute Barbatruc

Pièces jointes

Guest

Guest

Marion

XLDnaute Junior

Discussions similaires