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
 

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!)
 

Pièces jointes

  • V30056 Bordereau interieur.xls
    5.5 MB · Affichages: 49

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
 

Discussions similaires

Réponses
0
Affichages
83
Réponses
14
Affichages
621

Statistiques des forums

Discussions
311 724
Messages
2 081 938
Membres
101 844
dernier inscrit
pktla