Regrouper 2 macro très lentes

martinigi

XLDnaute Nouveau
Bonjour, je suis encore un peut débutant dans le monde du VBA et je bloque sur une macro. Résultat je doit l'exécuter en 2 fois et la macro est extrêmement lente de part la quantité de ligne à vérifier.
Merci de votre aide
Voici le code de mes macro :

Sub Macro12()
'Inscrit le code 89 ou 5
For i = 4 To 65000
If Cells(i, "C") = 1 Then Cells(i, "J").Value = 89 Else
If Cells(i, "J") = 89 Or Cells(i, "J") = "" Then If Cells(i, "C").Value = 1 Then Cells(i, "J").Value = 89 Else Cells(i, "J").Value = 5
Next i
End Sub

Sub macro13()
'Recherche les autre codes
For i = 4 To 65000
Cells(i, "K").Select
If Cells(i, "J") = 89 Then ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[4],Phases!R1C1:R100C6,3,FALSE)" Else 'colonne K
Next i
'Formules à integrer dans la macro
If Cells(i, "J") = 89 Then ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[3],Phases!R1C1:R100C6,4,FALSE)" Else 'colonne L
If Cells(i, "J") = 89 Then ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[2],Phases!R1C1:R100C6,5,FALSE)" Else 'colonne M
 

pierrejean

XLDnaute Barbatruc
Bonjour martinigi

Peux-tu créer un fichier exemple avec quelques lignes de données représentatives et le résultat espéré
(copie de ton fichier allégé avec données 'bidon')
 

martinigi

XLDnaute Nouveau
Voici le tableu que j'utilise :
Lors de l'utilisation de la macro, j'aurai souhaité qu'elle recherche tout les chiffre 89 de la colonne J et qu'elle inscrive sur les colonnes K L M le code correspondant au tableau de la feuille (phase!)
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Hello

avec ceci peut etre?
VB:
Sub macro13()
application.screenupdating=false
'on cherche la dernière ligne
Fin = Sheets("Feuil3").UsedRange.Rows.Count

For i = 4 To Fin
    If Cells(i, "J") = 89 Then
        Cells(i, "K").FormulaR1C1 = "=VLOOKUP(RC[4],Phases!R1C1:R100C6,3,FALSE)" 'colonne K
        Cells(i, "L").FormulaR1C1 = "=VLOOKUP(RC[3],Phases!R1C1:R100C6,4,FALSE)" 'colonne L
        Cells(i, "M").FormulaR1C1 = "=VLOOKUP(RC[2],Phases!R1C1:R100C6,5,FALSE)" 'colonne M
    End If
Next i
application.screenupdating=true
End Sub
 

Dranreb

XLDnaute Barbatruc
Bonsoir.
Je pense que je ferais quelque chose de plus rapide, comme ça :
VB:
Sub Macro12Et13()
With Intersect([4:65000], ActiveSheet.UsedRange)
   .Columns("AI").FormulaR1C1 = "=IF(RC3=1,89,IF(ISBLANK(RC10),5,RC10))"
   .Columns("J").Value = .Columns("AI").Value
   .Columns("AI").FormulaR1C1 = "=1/(RC10=89)"
   Intersect(.Columns("AI").SpecialCells(xlCellTypeFormulas, 1).EntireRow, .Columns("K:M")) _
      .FormulaR1C1 = "=VLOOKUP(RC15,Phases!R1C1:R100C6,COLUMN()-8,FALSE)"
   .Columns("AI").Delete: End With
End Sub
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas