Optimisation du code VBA (array)

Bonjour à tous,

voici ci-joint mon fichier avec une macro qui met en feuille3 les données de la feuille1 et de la feuille2. Cette macro fonctionne parfaitement cependant elle met du temps à s'exécuter (dû certainement au grand nombre de lignes). Avez-vous des idées pour optimiser ce code afin qu'il soit plus rapide lors de l'exécution?

Bonjour,

Sub colonnes()

    Sheets(3).Range("A2").CurrentRegion.Clear
    Sheets(1).Range("A1").CurrentRegion.Copy Destination:=Sheets(3).Range("A2")
    Sheets(2).Range("A1").CurrentRegion.Copy Destination:=Sheets(3).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

End Sub

Bonjour,

a tester 0,3 seconde au lieu de 52 secondes, par utilisation d'un dictionnaire :

Sub colonnes()

    Application.ScreenUpdating = False 'arrête le travail en arrière plan
    Application.DisplayStatusBar = False 'inhibe la mise a jour de la barre d'état
    Application.Calculation = xlCalculationManual 'le mode de calcul devient manuel
    ActiveSheet.DisplayPageBreaks = False 'n'affiche plus les sauts de pages
    Application.DisplayAlerts = False

Dim ligne1 As Long, ligne2 As Long, i As Long, j As Long, fin As Long
Dim T1, T2, Resultat(), Dico
    deb = Timer
    Set Dico = CreateObject("Scripting.Dictionary")
    ligne1 = Sheets(1).Range("A1").End(xlDown).Row
    ligne2 = Sheets(2).Range("A1").End(xlDown).Row

    ReDim Resultat(1 To ligne1, 1 To 4)

    T1 = Sheets(1).Range("A1:D" & ligne1)
    T2 = Sheets(2).Range("A1:B" & ligne2)

    For i = LBound(T2, 1) To UBound(T2, 1)
        Dico(T2(i, 2)) = T2(i, 1)
    Next

    For i = 1 To UBound(T1)
        If Dico.Exists(T1(i, 2)) Then
            x = x + 1
            Resultat(x, 1) = T1(i, 1)
            Resultat(x, 2) = Dico(T1(i, 2))
            Resultat(x, 3) = T1(i, 3)
            Resultat(x, 4) = T1(i, 4)
        End If
    Next

    Sheets(3).Range("A1").Resize(x, 4) = Resultat

    Erase T1
    Erase T2
    Erase Resultat
    MsgBox "fin en :" & Timer - deb
    Application.ScreenUpdating = True ' travail en arrière plan
    Application.DisplayStatusBar = True 'la barre d'état est mise a jour
    Application.Calculation = xlAutomatic 'le mode de calcul redevient automatique
    ActiveSheet.DisplayPageBreaks = True 'affiche les sauts de pages
    Application.DisplayAlerts = True

End Sub

A+

Bonsoir tous

ton fichier en retour en 0,15 seconde

a+

Papou

Je ne dois pas avoir bien compris le sujet alors !!

Je me suis contenté de faire

une macro qui met en feuille3 les données de la feuille1 et de la feuille2

Mais s'il y a des redondances à enlever, on peut ajouter des instructions !

Bonjour à tous,

Dans la mesure ou les feuilles 1 et 2 sont dans le même ordre, les solutions de Steelson et paritec pourraient convenir .

Mais comme il y a moins de ligne en feuille 2 qu'en feuille1, le résultat en feuille 3 serait limité au nombre de lignes en feuille 2 (comme la macro origine) ? à moins que la feuille 2 n'e soit pas complète, pour l'exemple ...

Bonne fin de journée

Bonjour a tous,

Merci beaucoup pour toutes vos réponses, c'est top!

Puis-je vous demander de l'aide aussi pour cette macro dans le fichier ci-joint. Le principe est le même: ma macro marche mais je n'arrive pas a l'optimiser même grâce a vos proposition ci dessus.

Merci beaucoup

J'ai oublier le code dans le fichier , le voici:

Sub données()

Dim ligne As Long, ligne1 As Long, c As Long, i As Long, j As Long, l As Long

ligne2 = Sheets(2).Range("A1").End(xlDown).Row

ligne1 = Sheets(1).Range("B1").End(xlDown).Row

ReDim T1(ligne1, 3)

ReDim T2(ligne2, 4)

Sheets(1).Activate

c = 1

For i = 2 To ligne1

T1(c, 0) = Range("A" & i).Value

T1(c, 1) = Range("B" & i).Value

T1(c, 2) = Range("C" & i).Value

T1(c, 3) = Right(Range("D" & i).Value, 1)

c = c + 1

Next

Sheets(2).Activate

l = 1

For i = 2 To ligne2

T2(l, 0) = Range("A" & i).Value

T2(l, 1) = Range("B" & i).Value

T2(l, 2) = Right(Range("C" & i).Value, 1)

l = l + 1

Next

ReDim T_f0(ligne2, 2)

ReDim T_f1(ligne2, 2)

ReDim T_f(ligne2, 2)

Sheets(1).Activate

For j = 0 To UBound(T1)

For i = 0 To UBound(T2)

If (T1(j, 3) = T2(i, 2)) And T1(j, 2) <> "" Then

If T1(j, 2) = "Lola" Then

T_f0(j, 0) = T1(j, 0)

T_f0(j, 1) = "Lola"

T_f0(j, 2) = T1(j, 3)

End If

If T1(j, 2) = "Quentin" Then

T_f1(j, 0) = T1(j, 0)

T_f1(j, 1) = "Quentin"

T_f1(j, 2) = T1(j, 3)

End If

If T1(j, 2) = "Pierre" Then

T_f(j, 0) = T1(j, 0)

T_f(j, 1) = "Pierre"

T_f(j, 2) = T1(j, 3)

End If

End If

Next

Next

Range("F1").Resize(UBound(T_f0, 1) + 1, UBound(T_f0, 2) + 1) = T_f0

Range("J1").Resize(UBound(T_f1, 1) + 1, UBound(T_f1, 2) + 1) = T_f1

Range("N1").Resize(UBound(T_f, 1) + 1, UBound(T_f, 2) + 1) = T_f

Erase T_f0

Erase T_f1

Erase T_f

End Sub