Macro remplace formule trop longue mais pb temps

Marion

XLDnaute Junior
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 :cool:

Marion
 
Dernière édition:

Cousinhub

XLDnaute Barbatruc
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 :D:D
 

Cousinhub

XLDnaute Barbatruc
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?
 

Cousinhub

XLDnaute Barbatruc
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

XLDnaute Junior
Re : Macro remplace formule trop longue mais pb temps

Merci bhbh pour ton intérêt :eek:
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.....:eek:

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

Pièces jointes

  • macro test.zip
    46.4 KB · Affichages: 36
  • macro test.zip
    46.4 KB · Affichages: 35
  • macro test.zip
    46.4 KB · Affichages: 33

Marion

XLDnaute Junior
Re : Macro remplace formule trop longue mais pb temps

Bonjour le forum,
:rolleyes: 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:confused:
 

pierrejean

XLDnaute Barbatruc
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
 

Pièces jointes

  • macro test.zip
    45.6 KB · Affichages: 21
  • macro test.zip
    45.6 KB · Affichages: 27
  • macro test.zip
    45.6 KB · Affichages: 30
G

Guest

Guest
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

XLDnaute Junior
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.
 

Discussions similaires

Réponses
14
Affichages
621
Réponses
17
Affichages
251
Réponses
4
Affichages
165

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof